Released PRC*5.1*226 SEQ #198 Extracted from mail message **KIDS**:PRC*5.1*226^ **INSTALL NAME** PRC*5.1*226 "BLD",7714,0) PRC*5.1*226^IFCAP^0^3211221^y "BLD",7714,1,0) ^^3^3^3211221^^ "BLD",7714,1,1,0) This patch changes the default directory for the "Enter the file's "BLD",7714,1,2,0) directory: " prompts for the item and manufacturer bulk load options. It "BLD",7714,1,3,0) also provides a default file name for the manufacturer bulk load option. "BLD",7714,4,0) ^9.64PA^^ "BLD",7714,6.3) 2 "BLD",7714,"ABPKG") n "BLD",7714,"KRN",0) ^9.67PA^1.61^24 "BLD",7714,"KRN",.4,0) .4 "BLD",7714,"KRN",.401,0) .401 "BLD",7714,"KRN",.402,0) .402 "BLD",7714,"KRN",.403,0) .403 "BLD",7714,"KRN",.5,0) .5 "BLD",7714,"KRN",.84,0) .84 "BLD",7714,"KRN",1.6,0) 1.6 "BLD",7714,"KRN",1.61,0) 1.61 "BLD",7714,"KRN",1.62,0) 1.62 "BLD",7714,"KRN",3.6,0) 3.6 "BLD",7714,"KRN",3.8,0) 3.8 "BLD",7714,"KRN",9.2,0) 9.2 "BLD",7714,"KRN",9.8,0) 9.8 "BLD",7714,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",7714,"KRN",9.8,"NM",1,0) PRCHITM3^^0^B61204317 "BLD",7714,"KRN",9.8,"NM",2,0) PRCHITM6^^0^B38341424 "BLD",7714,"KRN",9.8,"NM","B","PRCHITM3",1) "BLD",7714,"KRN",9.8,"NM","B","PRCHITM6",2) "BLD",7714,"KRN",19,0) 19 "BLD",7714,"KRN",19.1,0) 19.1 "BLD",7714,"KRN",101,0) 101 "BLD",7714,"KRN",409.61,0) 409.61 "BLD",7714,"KRN",771,0) 771 "BLD",7714,"KRN",779.2,0) 779.2 "BLD",7714,"KRN",870,0) 870 "BLD",7714,"KRN",8989.51,0) 8989.51 "BLD",7714,"KRN",8989.52,0) 8989.52 "BLD",7714,"KRN",8993,0) 8993 "BLD",7714,"KRN",8994,0) 8994 "BLD",7714,"KRN","B",.4,.4) "BLD",7714,"KRN","B",.401,.401) "BLD",7714,"KRN","B",.402,.402) "BLD",7714,"KRN","B",.403,.403) "BLD",7714,"KRN","B",.5,.5) "BLD",7714,"KRN","B",.84,.84) "BLD",7714,"KRN","B",1.6,1.6) "BLD",7714,"KRN","B",1.61,1.61) "BLD",7714,"KRN","B",1.62,1.62) "BLD",7714,"KRN","B",3.6,3.6) "BLD",7714,"KRN","B",3.8,3.8) "BLD",7714,"KRN","B",9.2,9.2) "BLD",7714,"KRN","B",9.8,9.8) "BLD",7714,"KRN","B",19,19) "BLD",7714,"KRN","B",19.1,19.1) "BLD",7714,"KRN","B",101,101) "BLD",7714,"KRN","B",409.61,409.61) "BLD",7714,"KRN","B",771,771) "BLD",7714,"KRN","B",779.2,779.2) "BLD",7714,"KRN","B",870,870) "BLD",7714,"KRN","B",8989.51,8989.51) "BLD",7714,"KRN","B",8989.52,8989.52) "BLD",7714,"KRN","B",8993,8993) "BLD",7714,"KRN","B",8994,8994) "BLD",7714,"QDEF") ^^^^NO^^^^NO^^YES "BLD",7714,"QUES",0) ^9.62^^ "BLD",7714,"REQB",0) ^9.611^1^1 "BLD",7714,"REQB",1,0) PRC*5.1*198^1 "BLD",7714,"REQB","B","PRC*5.1*198",1) "MBREQ") 0 "PKG",455,-1) 1^1 "PKG",455,0) IFCAP^PRC^IFCAP System Files "PKG",455,22,0) ^9.49I^1^1 "PKG",455,22,1,0) 5.1^3001012^3001019^68 "PKG",455,22,1,"PAH",1,0) 226^3211221 "PKG",455,22,1,"PAH",1,1,0) ^^3^3^3211221 "PKG",455,22,1,"PAH",1,1,1,0) This patch changes the default directory for the "Enter the file's "PKG",455,22,1,"PAH",1,1,2,0) directory: " prompts for the item and manufacturer bulk load options. It "PKG",455,22,1,"PAH",1,1,3,0) also provides a default file name for the manufacturer bulk load option. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") YES "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 2 "RTN","PRCHITM3") 0^1^B61204317^B60839011 "RTN","PRCHITM3",1,0) PRCHITM3 ;OI&T/LKG - READING 832 TXN IN HOST FILE ;12/20/21 22:14 "RTN","PRCHITM3",2,0) ;;5.1;IFCAP;**198,226**;OCT 20, 2000;Build 2 "RTN","PRCHITM3",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","PRCHITM3",4,0) ;Integration agreements "RTN","PRCHITM3",5,0) ; ICR #2320: CLOSE^%ZISH(),$$LIST^%ZISH(),OPEN^%ZISH(),$$STATUS^%ZISH() "RTN","PRCHITM3",6,0) ; ICR #2171: $$STA^XUAF4() "RTN","PRCHITM3",7,0) ; ICR #2541: $$KSP^XUPARAM() "RTN","PRCHITM3",8,0) ; ICR #4440: $$PROD^XUPROD() "RTN","PRCHITM3",9,0) ; ICR #10026: ^DIR "RTN","PRCHITM3",10,0) ; ICR #10070: ^XMD "RTN","PRCHITM3",11,0) ; ICR #10142: EN^DDIOL() "RTN","PRCHITM3",12,0) ST ;Entry point "RTN","PRCHITM3",13,0) N DIR,DTOUT,DUOUT,DIROUT,DIRUT,POP,X,Y,PRCI,PRCLFARR,PRCLFDIR,PRCLFF,PRCLFFIL,PRCLFIN,PRCFATAL S PRCFATAL=0 "RTN","PRCHITM3",14,0) N ZTSK,ZTSAVE,ZTDTM,ZTRTN,ZTDESC,ZTIO,PRCX "RTN","PRCHITM3",15,0) GETDIR S DIR(0)="FA^1:75",DIR("A")="Enter the file's directory: ",DIR("B")="/srv/vista/patches/.NIF/" "RTN","PRCHITM3",16,0) S DIR("?",1)="Enter name of the directory containing the file.",DIR("?")=" Directory value is up to 75 characters in the format for the operating system." "RTN","PRCHITM3",17,0) D ^DIR I $D(DIRUT) S PRCFATAL=1 G END "RTN","PRCHITM3",18,0) S PRCLFDIR=Y "RTN","PRCHITM3",19,0) K DIR S DIR(0)="FA^1:50^K:X'?1.46ANP1"".""3A X",DIR("A")="Enter file name: ",DIR("?",1)="Enter the name of file with extension that you wish to process." "RTN","PRCHITM3",20,0) S DIR("?")="File name up to 50 characters, without directory." "RTN","PRCHITM3",21,0) D ^DIR I $D(DIRUT) S PRCFATAL=1 G END "RTN","PRCHITM3",22,0) S PRCLFFIL=Y K DIR "RTN","PRCHITM3",23,0) S PRCLFF(PRCLFFIL)="",PRCX=$$LIST^%ZISH(PRCLFDIR,"PRCLFF","PRCLFARR") "RTN","PRCHITM3",24,0) K PRCLFF,PRCLFARR "RTN","PRCHITM3",25,0) I 'PRCX W !,"File not found!" G GETDIR "RTN","PRCHITM3",26,0) D OPEN^%ZISH("PRCLFIN",PRCLFDIR,PRCLFFIL,"R",) "RTN","PRCHITM3",27,0) I POP W !,"Unable to open file "_PRCLFDIR_PRCLFFIL_"." S PRCFATAL=1 G END "RTN","PRCHITM3",28,0) U IO "RTN","PRCHITM3",29,0) F PRCI=1:1 R PRCX:DTIME Q:$E(PRCX,1,4)="ISA^" Q:$$STATUS^%ZISH!($P(PRCX,"^")="***END OF FILE***") "RTN","PRCHITM3",30,0) I $E(PRCX,1,4)'="ISA^" U IO(0) D EN^DDIOL("*** ISA segment is missing. ***","","!!?10") S PRCFATAL=1 D CLOSE^%ZISH("PRCLFIN") G END "RTN","PRCHITM3",31,0) U IO(0) W ! "RTN","PRCHITM3",32,0) N PRCISITE,PRCRSITE S PRCISITE=$P($P($P(PRCX,"^",9),"~",2)," "),PRCRSITE=$$STA^XUAF4($$KSP^XUPARAM("INST")) "RTN","PRCHITM3",33,0) S:PRCISITE="" PRCISITE="not specified" "RTN","PRCHITM3",34,0) I PRCISITE'="ALL",PRCISITE'=PRCRSITE D G END "RTN","PRCHITM3",35,0) . N PRCMSG S PRCMSG(1)="*** Wrong receiving station; Import aborted ***" "RTN","PRCHITM3",36,0) . S PRCMSG(2)="832 Txn ICN "_$P(PRCX,"^",14)_" for station "_PRCISITE_" was sent to "_PRCRSITE_"." "RTN","PRCHITM3",37,0) . D EN^DDIOL(.PRCMSG) "RTN","PRCHITM3",38,0) . S PRCFATAL=1 D CLOSE^%ZISH("PRCLFIN") "RTN","PRCHITM3",39,0) K DIR S DIR(0)="YA",DIR("A")="Do you want to queue the item load? ",DIR("B")="YES" "RTN","PRCHITM3",40,0) S DIR("?")="Enter 'YES' to run in background or 'NO' to run in foreground." "RTN","PRCHITM3",41,0) D ^DIR I $D(DIRUT) S PRCFATAL=1 D CLOSE^%ZISH("PRCLFIN") G END "RTN","PRCHITM3",42,0) I Y D G END "RTN","PRCHITM3",43,0) . D CLOSE^%ZISH("PRCLFIN") "RTN","PRCHITM3",44,0) . S ZTRTN="RUN^PRCHITM3",ZTDESC="NIF/IFCAP Item Load",ZTIO="" "RTN","PRCHITM3",45,0) . S ZTSAVE("PRCLFDIR")="",ZTSAVE("PRCLFFIL")="",ZTSAVE("DUZ")="",ZTSAVE("DTIME")="" "RTN","PRCHITM3",46,0) . D ^%ZTLOAD W !,"Task #=",$G(ZTSK) "RTN","PRCHITM3",47,0) U IO "RTN","PRCHITM3",48,0) ; "RTN","PRCHITM3",49,0) RUN ; "RTN","PRCHITM3",50,0) N POP,X,Y,PRCI,PRCJ,PRCK,PRCLFIN,PRCLFARR I $D(ZTQUEUED) N PRCX "RTN","PRCHITM3",51,0) N PRCTXN,PRCHNODE,PRCERRC,PRCLCTR,PRCIUPD,PRCITC,PRCFATAL S PRCLCTR=0,PRCIUPD=0,PRCFATAL=0 "RTN","PRCHITM3",52,0) N PRCSTN S PRCSTN=$$STA^XUAF4($$KSP^XUPARAM("INST")) "RTN","PRCHITM3",53,0) I $D(ZTQUEUED) D G:POP END "RTN","PRCHITM3",54,0) . D OPEN^%ZISH("PRCLFIN",PRCLFDIR,PRCLFFIL,"R",,"P-OTHER") "RTN","PRCHITM3",55,0) . I POP D Q "RTN","PRCHITM3",56,0) . . N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ "RTN","PRCHITM3",57,0) . . S XMSUB="NIF/IFCAP Item Load Failure",XMDUZ=.5,XMY("G.ISM")="",XMY(DUZ)="" "RTN","PRCHITM3",58,0) . . S PRCARR(1)="Unable to open host file "_PRCLFDIR_PRCLFFIL,XMTEXT="PRCARR(" "RTN","PRCHITM3",59,0) . . D ^XMD "RTN","PRCHITM3",60,0) . U IO "RTN","PRCHITM3",61,0) . F PRCI=1:1 R PRCX:DTIME Q:$E(PRCX,1,4)="ISA^" Q:$$STATUS^%ZISH "RTN","PRCHITM3",62,0) I '$$STATUS^%ZISH D "RTN","PRCHITM3",63,0) . S PRCTXN=$P(PRCX,"^",14) D INITLOG^PRCHITM5(PRCTXN) "RTN","PRCHITM3",64,0) . F PRCI=1:1 R PRCX:DTIME Q:$$STATUS^%ZISH!($E(PRCX,1,4)="IEA^") D Q:$$STATUS^%ZISH "RTN","PRCHITM3",65,0) . . I $E(PRCX,1,3)="ST^" D PROCTXN "RTN","PRCHITM3",66,0) D CLOSE^%ZISH("PRCLFIN") "RTN","PRCHITM3",67,0) I $D(PRCHNODE),$D(^XTMP(PRCHNODE,"ERR")) D "RTN","PRCHITM3",68,0) . N PRCARR,PRCC,PRCI,PRCJ,PRCK,PRCL S PRCC=0,PRCI=0,PRCJ=0,PRCK=0,PRCL=120 "RTN","PRCHITM3",69,0) . F S PRCI=$O(^XTMP(PRCHNODE,"ERR",PRCI)) Q:PRCI="" S PRCC=PRCC+1 "RTN","PRCHITM3",70,0) . S PRCC=PRCC\PRCL+$S(PRCC#PRCL>0:1,1:0),PRCI=0 "RTN","PRCHITM3",71,0) . F S PRCI=$O(^XTMP(PRCHNODE,"ERR",PRCI)) Q:PRCI="" D "RTN","PRCHITM3",72,0) . . S PRCJ=PRCJ+1,PRCARR(PRCJ)=^XTMP(PRCHNODE,"ERR",PRCI) "RTN","PRCHITM3",73,0) . . I PRCJ=PRCL D "RTN","PRCHITM3",74,0) . . . S PRCK=PRCK+1 D SEND(.PRCARR,$P(PRCHNODE,";",2),PRCK,PRCC,PRCSTN) "RTN","PRCHITM3",75,0) . . . K PRCARR S PRCJ=0 "RTN","PRCHITM3",76,0) . I $D(PRCARR) S PRCK=PRCK+1 D SEND(.PRCARR,$P(PRCHNODE,";",2),PRCK,PRCC,PRCSTN) "RTN","PRCHITM3",77,0) I $D(PRCHNODE) D "RTN","PRCHITM3",78,0) . N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ,PRCARR "RTN","PRCHITM3",79,0) . S XMSUB="Stn "_PRCSTN_" Statistics NIF/IFCAP 832 Txn ICN "_$P(PRCHNODE,";",2) "RTN","PRCHITM3",80,0) . S PRCARR(1)="Transaction Item Lines Processed: "_PRCLCTR,PRCARR(2)="Item Master File Entries Updated: "_PRCIUPD "RTN","PRCHITM3",81,0) . S XMDUZ=.5,XMTEXT="PRCARR(",XMY("G.ISM")="",XMY(DUZ)="" "RTN","PRCHITM3",82,0) . S:$$PROD^XUPROD() XMY("VHANIFMO@domain.ext")="" "RTN","PRCHITM3",83,0) . D ^XMD "RTN","PRCHITM3",84,0) ; "RTN","PRCHITM3",85,0) END ; "RTN","PRCHITM3",86,0) S:$D(ZTQUEUED) ZTREQ="@" "RTN","PRCHITM3",87,0) W:'$D(ZTQUEUED) !!,$S(PRCFATAL:"",1:"") "RTN","PRCHITM3",88,0) K ^TMP($J,"PRCHITM3") K PRCLFDIR,PRCLFFILE "RTN","PRCHITM3",89,0) Q "RTN","PRCHITM3",90,0) ; "RTN","PRCHITM3",91,0) PROCTXN ; "RTN","PRCHITM3",92,0) K ^TMP($J,"PRCHITM3") N PRCTRANS,PRCTXNTYPE S PRCTRANS=$P(PRCX,"^",3),PRCTXNTYPE=$P(PRCX,"^",2) "RTN","PRCHITM3",93,0) I PRCTXNTYPE'=832 D ERR^PRCHITM5("Trans #"_PRCTRANS_" is not X.12 832 type.") Q "RTN","PRCHITM3",94,0) F PRCJ=1:1 R PRCX:DTIME Q:$E(PRCX,1,3)="SE^"!$$STATUS^%ZISH D Q:$$STATUS^%ZISH "RTN","PRCHITM3",95,0) . D:$E(PRCX,1,4)="REF^" REF "RTN","PRCHITM3",96,0) . D:$E(PRCX,1,3)="N1^" N1 "RTN","PRCHITM3",97,0) . I $E(PRCX,1,4)="LIN^" D LIN S PRCLCTR=PRCLCTR+1 I '$D(ZTQUEUED),PRCLCTR#25=0 U IO(0) W:$X>60 ! W $J(PRCLCTR,6) U IO "RTN","PRCHITM3",98,0) Q "RTN","PRCHITM3",99,0) REF ;Process REF segments "RTN","PRCHITM3",100,0) I $P(PRCX,"^",4)="IEN",$P(PRCX,"^",3)'="" S ^TMP($J,"PRCHITM3","VEN","IEN")=$P(PRCX,"^",3) "RTN","PRCHITM3",101,0) E D ERR^PRCHITM5("Erroneous vendor '"_$P(PRCX,"^",4)_"' REF segment for ST #"_PRCTRANS_".") "RTN","PRCHITM3",102,0) Q "RTN","PRCHITM3",103,0) N1 ; "RTN","PRCHITM3",104,0) N PRCL,PRCM S PRCM=0 "RTN","PRCHITM3",105,0) Q:$P(PRCX,"^",3)="" N PRCTYPE,PRCVALUE "RTN","PRCHITM3",106,0) S PRCTYPE=$P(PRCX,"^",5),PRCVALUE=$P(PRCX,"^",3) "RTN","PRCHITM3",107,0) I PRCTYPE="ORDER" S ^TMP($J,"PRCHITM3","VEN","ORDER NAME")=PRCVALUE "RTN","PRCHITM3",108,0) E D ERR^PRCHITM5("Erroneous vendor '"_PRCTYPE_"' N1 segment for ST #"_PRCTRANS_".") "RTN","PRCHITM3",109,0) Q "RTN","PRCHITM3",110,0) LIN ;Process Item Lines "RTN","PRCHITM3",111,0) N PRCLNCT,PRCLIN,PRCREFCT S PRCLNCT=0,PRCLIN=$P(PRCX,"^",2),PRCREFCT=0 "RTN","PRCHITM3",112,0) K ^TMP($J,"PRCHITM3","ITEM") "RTN","PRCHITM3",113,0) S:$P(PRCX,"^",4)'="" ^TMP($J,"PRCHITM3","ITEM","NIF#")=$P(PRCX,"^",4) "RTN","PRCHITM3",114,0) S:$P(PRCX,"^",6)'="" ^TMP($J,"PRCHITM3","ITEM","FSC")=$P(PRCX,"^",6) "RTN","PRCHITM3",115,0) S:$P(PRCX,"^",8)'="" ^TMP($J,"PRCHITM3","ITEM","NSN")=$P(PRCX,"^",8) "RTN","PRCHITM3",116,0) S:$P(PRCX,"^",10)'="" ^TMP($J,"PRCHITM3","ITEM","MFG PART")=$P(PRCX,"^",10) "RTN","PRCHITM3",117,0) S:$P(PRCX,"^",12)'="" ^TMP($J,"PRCHITM3","ITEM","VSTOCK#")=$P(PRCX,"^",12) "RTN","PRCHITM3",118,0) S:$P(PRCX,"^",14)'="" ^TMP($J,"PRCHITM3","ITEM","NDC")=$P(PRCX,"^",14) "RTN","PRCHITM3",119,0) S:$P(PRCX,"^",18)'="" ^TMP($J,"PRCHITM3","ITEM","BOC")=$P(PRCX,"^",18) "RTN","PRCHITM3",120,0) S:$P(PRCX,"^",20)'="" ^TMP($J,"PRCHITM3","ITEM","DRUG TYPE")=$P(PRCX,"^",20) "RTN","PRCHITM3",121,0) S:$P(PRCX,"^",22)'="" ^TMP($J,"PRCHITM3","ITEM","MANUFACTURER")=$P(PRCX,"^",22) "RTN","PRCHITM3",122,0) S:$P(PRCX,"^",24)'="" ^TMP($J,"PRCHITM3","ITEM","SOURCE MFG PART#")=$P(PRCX,"^",24) "RTN","PRCHITM3",123,0) S:$P(PRCX,"^",26)'="" ^TMP($J,"PRCHITM3","ITEM","SOURCE VENDOR STOCK#")=$P(PRCX,"^",26) "RTN","PRCHITM3",124,0) F PRCK=1:1 R PRCX:DTIME Q:$$STATUS^%ZISH D Q:$E(PRCX,1,4)="G55^" "RTN","PRCHITM3",125,0) . D:$E(PRCX,1,4)="SLN^" SLN "RTN","PRCHITM3",126,0) . D:$E(PRCX,1,4)="DTM^" DTM "RTN","PRCHITM3",127,0) . D:$E(PRCX,1,4)="REF^" IREF "RTN","PRCHITM3",128,0) . D:$E(PRCX,1,4)="CTB^" CTB "RTN","PRCHITM3",129,0) . D:$E(PRCX,1,4)="PID^" PID "RTN","PRCHITM3",130,0) . D:$E(PRCX,1,4)="PKG^" PKG "RTN","PRCHITM3",131,0) . D:$E(PRCX,1,4)="PO4^" PO4 "RTN","PRCHITM3",132,0) . D:$E(PRCX,1,4)="G55^" G55 "RTN","PRCHITM3",133,0) D FILE^PRCHITM5(PRCTRANS,PRCLIN,.PRCITC) S PRCIUPD=PRCIUPD+PRCITC "RTN","PRCHITM3",134,0) Q "RTN","PRCHITM3",135,0) SLN ; "RTN","PRCHITM3",136,0) S:$P(PRCX,"^",6)'="" ^TMP($J,"PRCHITM3","ITEM","UOP")=$P(PRCX,"^",6) "RTN","PRCHITM3",137,0) S:$P(PRCX,"^",7)'="" ^TMP($J,"PRCHITM3","ITEM","UNIT COST")=$P(PRCX,"^",7) "RTN","PRCHITM3",138,0) S:$P(PRCX,"^",11)'="" ^TMP($J,"PRCHITM3","ITEM","CONTRACT")=$P(PRCX,"^",11) "RTN","PRCHITM3",139,0) Q "RTN","PRCHITM3",140,0) DTM ; "RTN","PRCHITM3",141,0) I $P(PRCX,"^",3)'="",$P(PRCX,"^",2)=167 S ^TMP($J,"PRCHITM3","ITEM","NIF UPDATE DATE")=$P(PRCX,"^",3) "RTN","PRCHITM3",142,0) Q "RTN","PRCHITM3",143,0) IREF ; "RTN","PRCHITM3",144,0) S:$P(PRCX,"^",4)'="" PRCREFCT=PRCREFCT+1,^TMP($J,"PRCHITM3","ITEM","SYN",PRCREFCT)=$P(PRCX,"^",4) "RTN","PRCHITM3",145,0) Q "RTN","PRCHITM3",146,0) CTB ; "RTN","PRCHITM3",147,0) N PRCCODE,PRCVALUE S PRCCODE=$P(PRCX,"^",4),PRCVALUE=$P(PRCX,"^",5) "RTN","PRCHITM3",148,0) I PRCCODE=57 S ^TMP($J,"PRCHITM3","ITEM","MIN QTY")=PRCVALUE "RTN","PRCHITM3",149,0) E I PRCCODE=70 S ^TMP($J,"PRCHITM3","ITEM","MAX QTY")=PRCVALUE "RTN","PRCHITM3",150,0) E I PRCCODE="AP" S ^TMP($J,"PRCHITM3","ITEM","ORDER QTY MULTIPLE")=PRCVALUE "RTN","PRCHITM3",151,0) Q "RTN","PRCHITM3",152,0) PID ; "RTN","PRCHITM3",153,0) S PRCLNCT=PRCLNCT+1 "RTN","PRCHITM3",154,0) S:$P(PRCX,"^",6)'="" ^TMP($J,"PRCHITM3","ITEM","LONG DESC",PRCLNCT)=$P(PRCX,"^",6) "RTN","PRCHITM3",155,0) Q "RTN","PRCHITM3",156,0) PKG ; "RTN","PRCHITM3",157,0) S:$P(PRCX,"^",5)'="" ^TMP($J,"PRCHITM3","ITEM","UNIT CONVERSION FACTOR")=$P(PRCX,"^",5) "RTN","PRCHITM3",158,0) S:$P(PRCX,"^",6)'="" ^TMP($J,"PRCHITM3","ITEM","SHORT DESC")=$P(PRCX,"^",6) "RTN","PRCHITM3",159,0) Q "RTN","PRCHITM3",160,0) PO4 ; "RTN","PRCHITM3",161,0) S:$P(PRCX,"^",2)'="" ^TMP($J,"PRCHITM3","ITEM","PKG MULT")=$P(PRCX,"^",2) "RTN","PRCHITM3",162,0) Q "RTN","PRCHITM3",163,0) G55 ; "RTN","PRCHITM3",164,0) S:$P(PRCX,"^",3)'="" ^TMP($J,"PRCHITM3","ITEM","IMFNBR")=$P(PRCX,"^",3) "RTN","PRCHITM3",165,0) S:$P(PRCX,"^",5)'="" ^TMP($J,"PRCHITM3","ITEM","STOCK KEEPING UNIT")=$P(PRCX,"^",5) "RTN","PRCHITM3",166,0) S PRCX="G55^" "RTN","PRCHITM3",167,0) Q "RTN","PRCHITM3",168,0) ; "RTN","PRCHITM3",169,0) ; Send e-mails with error messages "RTN","PRCHITM3",170,0) SEND(PRCA,PRCB,PRCC,PRCD,PRCE) ; "RTN","PRCHITM3",171,0) N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ "RTN","PRCHITM3",172,0) S XMSUB="Stn "_PRCE_" Errors NIF/IFCAP 832 Txn ICN "_PRCB_" Msg #"_PRCC_" of "_PRCD "RTN","PRCHITM3",173,0) S XMDUZ=.5,XMTEXT="PRCA(",XMY("G.ISM")="",XMY(DUZ)="" "RTN","PRCHITM3",174,0) S:$$PROD^XUPROD() XMY("VHANIFMO@domain.ext")="" "RTN","PRCHITM3",175,0) D ^XMD "RTN","PRCHITM3",176,0) Q "RTN","PRCHITM3",177,0) ; "RTN","PRCHITM3",178,0) ;PRCHITM3 "RTN","PRCHITM6") 0^2^B38341424^B37937541 "RTN","PRCHITM6",1,0) PRCHITM6 ;OI&T/LKG - LOAD MANUFACTURER ENTRIES FROM HOST FILE ;12/20/21 22:15 "RTN","PRCHITM6",2,0) ;;5.1;IFCAP;**198,226**;OCT 20, 2000;Build 2 "RTN","PRCHITM6",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","PRCHITM6",4,0) ;Integration agreements "RTN","PRCHITM6",5,0) ; ICR #2320: CLOSE^%ZISH(),$$LIST^%ZISH(),OPEN^%ZISH(),$$STATUS^%ZISH() "RTN","PRCHITM6",6,0) ; ICR #2171: $$STA^XUAF4() "RTN","PRCHITM6",7,0) ; ICR #2541: $$KSP^XUPARAM() "RTN","PRCHITM6",8,0) ; ICR #4440: $$PROD^XUPROD() "RTN","PRCHITM6",9,0) ; ICR #10026: ^DIR "RTN","PRCHITM6",10,0) ; ICR #10070: ^XMD "RTN","PRCHITM6",11,0) ; ICR #10142: EN^DDIOL() "RTN","PRCHITM6",12,0) ST ;Entry point "RTN","PRCHITM6",13,0) N DIR,DTOUT,DUOUT,DIROUT,DIRUT,POP,X,Y,PRCI,PRCLFARR,PRCLFDIR,PRCLFF,PRCLFFIL,PRCLFIN,PRCFATAL S PRCFATAL=0 "RTN","PRCHITM6",14,0) N ZTSK,ZTSAVE,ZTDTM,ZTRTN,ZTDESC,ZTIO,PRCX "RTN","PRCHITM6",15,0) GETDIR S DIR(0)="FA^1:75",DIR("A")="Enter the file's directory: ",DIR("B")="/srv/vista/patches/.NIF/" "RTN","PRCHITM6",16,0) S DIR("?",1)="Enter name of the directory containing the file.",DIR("?")=" Directory value is up to 75 characters in the format for the operating system." "RTN","PRCHITM6",17,0) D ^DIR I $D(DIRUT) S PRCFATAL=1 G END "RTN","PRCHITM6",18,0) S PRCLFDIR=Y "RTN","PRCHITM6",19,0) K DIR S DIR(0)="FA^1:50^K:X'?1.46ANP1"".""3A X",DIR("A")="Enter file name: ",DIR("?",1)="Enter the name of file with extension that you wish to process." "RTN","PRCHITM6",20,0) S DIR("?")="File name up to 50 characters, without directory.",DIR("B")="NIFMFGFILE.TXT" "RTN","PRCHITM6",21,0) D ^DIR I $D(DIRUT) S PRCFATAL=1 G END "RTN","PRCHITM6",22,0) S PRCLFFIL=Y K DIR "RTN","PRCHITM6",23,0) S PRCLFF(PRCLFFIL)="",PRCX=$$LIST^%ZISH(PRCLFDIR,"PRCLFF","PRCLFARR") "RTN","PRCHITM6",24,0) K PRCLFF,PRCLFARR "RTN","PRCHITM6",25,0) I 'PRCX W !,"File not found!" G GETDIR "RTN","PRCHITM6",26,0) D OPEN^%ZISH("PRCLFIN",PRCLFDIR,PRCLFFIL,"R",) "RTN","PRCHITM6",27,0) I POP W !,"Unable to open file "_PRCLFDIR_PRCLFFIL_"." S PRCFATAL=1 G END "RTN","PRCHITM6",28,0) U IO "RTN","PRCHITM6",29,0) F PRCI=1:1 R PRCX:DTIME Q:$P(PRCX,"^",1,2)="HDR^MANUFACTURER LIST" Q:$$STATUS^%ZISH "RTN","PRCHITM6",30,0) I $P(PRCX,"^",1,2)'="HDR^MANUFACTURER LIST" U IO(0) D EN^DDIOL("*** Wrong file: Not for Manufacturer Load.","","!!?10") S PRCFATAL=1 D CLOSE^%ZISH("PRCLFIN") G END "RTN","PRCHITM6",31,0) U IO(0) W ! "RTN","PRCHITM6",32,0) K DIR S DIR(0)="YA",DIR("A")="Do you want to queue the manufacturer load? ",DIR("B")="YES" "RTN","PRCHITM6",33,0) S DIR("?")="Enter 'YES' to run in background or 'NO' to run in foreground." "RTN","PRCHITM6",34,0) D ^DIR I $D(DIRUT) S PRCFATAL=1 D CLOSE^%ZISH("PRCLFIN") G END "RTN","PRCHITM6",35,0) I Y D G END "RTN","PRCHITM6",36,0) . D CLOSE^%ZISH("PRCLFIN") "RTN","PRCHITM6",37,0) . S ZTRTN="RUN^PRCHITM6",ZTDESC="Manufacturer File (#440.4) Load",ZTIO="" "RTN","PRCHITM6",38,0) . S ZTSAVE("PRCLFDIR")="",ZTSAVE("PRCLFFIL")="",ZTSAVE("DUZ")="",ZTSAVE("DTIME")="" "RTN","PRCHITM6",39,0) . D ^%ZTLOAD W !,"Task #=",$G(ZTSK) "RTN","PRCHITM6",40,0) U IO "RTN","PRCHITM6",41,0) ; "RTN","PRCHITM6",42,0) RUN ; "RTN","PRCHITM6",43,0) N POP,X,Y,PRCI,PRCJ,PRCK,PRCLFIN,PRCLFARR I $D(ZTQUEUED) N PRCX "RTN","PRCHITM6",44,0) N PRCTXN,PRCHNODE,PRCERRC,PRCLCTR,PRCIUPD,PRCITC,PRCFATAL S PRCLCTR=0,PRCIUPD=0,PRCFATAL=0 "RTN","PRCHITM6",45,0) N PRCLINES,PRCSTN S PRCSTN=$$STA^XUAF4($$KSP^XUPARAM("INST")),PRCLINES=0 "RTN","PRCHITM6",46,0) I $D(ZTQUEUED) D G:POP END "RTN","PRCHITM6",47,0) . D OPEN^%ZISH("PRCLFIN",PRCLFDIR,PRCLFFIL,"R",,"P-OTHER") "RTN","PRCHITM6",48,0) . I POP D Q "RTN","PRCHITM6",49,0) . . N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ "RTN","PRCHITM6",50,0) . . S XMSUB="IFCAP Manufacturer File Load Failure",XMDUZ=.5,XMY("G.ISM")="",XMY(DUZ)="" "RTN","PRCHITM6",51,0) . . S PRCARR(1)="Unable to open host file "_PRCLFDIR_PRCLFFIL,XMTEXT="PRCARR(" "RTN","PRCHITM6",52,0) . . D ^XMD "RTN","PRCHITM6",53,0) . U IO "RTN","PRCHITM6",54,0) . F PRCI=1:1 R PRCX:DTIME Q:$P(PRCX,"^",1,2)="HDR^MANUFACTURER LIST" Q:$$STATUS^%ZISH "RTN","PRCHITM6",55,0) I '$$STATUS^%ZISH D "RTN","PRCHITM6",56,0) . S PRCTXN=$P(PRCX,"^",5) D INITLOG(PRCTXN) "RTN","PRCHITM6",57,0) . F PRCI=1:1 R PRCX:DTIME Q:$$STATUS^%ZISH!($P(PRCX,"^")="***END OF FILE***") D "RTN","PRCHITM6",58,0) . . I $P(PRCX,"^")="REC" D "RTN","PRCHITM6",59,0) . . . N PRCARR,PRCDUNS,PRCERR,PRCIEN,PRCNAME,PRCSTATUS S PRCIEN(1)=$P(PRCX,"^",2),PRCNAME=$P(PRCX,"^",3),PRCDUNS=$P(PRCX,"^",4),PRCSTATUS=$P(PRCX,"^",5) "RTN","PRCHITM6",60,0) . . . S PRCLINES=PRCLINES+1 "RTN","PRCHITM6",61,0) . . . I +PRCIEN(1)'=PRCIEN(1)!(PRCIEN(1)'>0) S PRCERR("DIERR")=1,PRCERR("DIERR",1,"TEXT",1)="The value '"_PRCIEN(1)_"' for field ID NUMBER in file MANUFACTURER is not valid." D LOGERR(.PRCERR,PRCIEN(1)) Q "RTN","PRCHITM6",62,0) . . . I '$D(^PRC(440.4,PRCIEN(1))) D Q "RTN","PRCHITM6",63,0) . . . . S PRCARR(440.4,"+1,",.001)=PRCIEN(1),PRCARR(440.4,"+1,",.01)=PRCNAME "RTN","PRCHITM6",64,0) . . . . S:PRCDUNS'="" PRCARR(440.4,"+1,",.5)=PRCDUNS "RTN","PRCHITM6",65,0) . . . . S:PRCSTATUS="I" PRCARR(440.4,"+1,",1)="INACTIVE" "RTN","PRCHITM6",66,0) . . . . I ";A;I;"'[(";"_PRCSTATUS_";") S PRCARR(440.4,"+1,",1)=PRCSTATUS "RTN","PRCHITM6",67,0) . . . . D UPDATE^DIE("EK","PRCARR","PRCIEN","PRCERR") "RTN","PRCHITM6",68,0) . . . . D:$D(PRCERR) LOGERR(.PRCERR,PRCIEN(1)) "RTN","PRCHITM6",69,0) . . . . S:'$D(PRCERR) PRCLCTR=PRCLCTR+1 "RTN","PRCHITM6",70,0) . . . S PRCARR(440.4,PRCIEN(1)_",",.01)=PRCNAME "RTN","PRCHITM6",71,0) . . . S:PRCDUNS'="" PRCARR(440.4,PRCIEN(1)_",",.5)=PRCDUNS "RTN","PRCHITM6",72,0) . . . S:PRCSTATUS'="" PRCARR(440.4,PRCIEN(1)_",",1)=$S(PRCSTATUS="I":"INACTIVE",PRCSTATUS="A":"@",1:PRCSTATUS) "RTN","PRCHITM6",73,0) . . . D FILE^DIE("EK","PRCARR","PRCERR") "RTN","PRCHITM6",74,0) . . . D:$D(PRCERR) LOGERR(.PRCERR,PRCIEN(1)) "RTN","PRCHITM6",75,0) . . . S:'$D(PRCERR) PRCIUPD=PRCIUPD+1 "RTN","PRCHITM6",76,0) D CLOSE^%ZISH("PRCLFIN") "RTN","PRCHITM6",77,0) ; "RTN","PRCHITM6",78,0) I $D(PRCHNODE),$D(^XTMP(PRCHNODE,"ERR")) D "RTN","PRCHITM6",79,0) . N PRCARR,PRCC,PRCI,PRCJ,PRCK,PRCL S PRCC=0,PRCI=0,PRCJ=0,PRCK=0,PRCL=120 "RTN","PRCHITM6",80,0) . F S PRCI=$O(^XTMP(PRCHNODE,"ERR",PRCI)) Q:PRCI="" S PRCC=PRCC+1 "RTN","PRCHITM6",81,0) . S PRCC=PRCC\PRCL+$S(PRCC#PRCL>0:1,1:0),PRCI=0 "RTN","PRCHITM6",82,0) . F S PRCI=$O(^XTMP(PRCHNODE,"ERR",PRCI)) Q:PRCI="" D "RTN","PRCHITM6",83,0) . . S PRCJ=PRCJ+1,PRCARR(PRCJ)=^XTMP(PRCHNODE,"ERR",PRCI) "RTN","PRCHITM6",84,0) . . I PRCJ=PRCL D "RTN","PRCHITM6",85,0) . . . S PRCK=PRCK+1 D SEND(.PRCARR,PRCTXN,PRCK,PRCC,PRCSTN) "RTN","PRCHITM6",86,0) . . . K PRCARR S PRCJ=0 "RTN","PRCHITM6",87,0) . I $D(PRCARR) S PRCK=PRCK+1 D SEND(.PRCARR,PRCTXN,PRCK,PRCC,PRCSTN) "RTN","PRCHITM6",88,0) I $D(PRCHNODE) D "RTN","PRCHITM6",89,0) . N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ,PRCARR "RTN","PRCHITM6",90,0) . S XMSUB="Stn "_PRCSTN_" Statistics Manufacturer Load File "_PRCTXN "RTN","PRCHITM6",91,0) . S PRCARR(1)="Number of Manufacturer records: "_PRCLINES "RTN","PRCHITM6",92,0) . S PRCARR(2)="Number of file entries successfully created: "_PRCLCTR,PRCARR(3)="Number of file entries successfully updated: "_PRCIUPD "RTN","PRCHITM6",93,0) . S XMDUZ=.5,XMTEXT="PRCARR(",XMY("G.ISM")="",XMY(DUZ)="" "RTN","PRCHITM6",94,0) . S:$$PROD^XUPROD() XMY("VHANIFMO@domain.ext")="" "RTN","PRCHITM6",95,0) . D ^XMD "RTN","PRCHITM6",96,0) END ; "RTN","PRCHITM6",97,0) S:$D(ZTQUEUED) ZTREQ="@" "RTN","PRCHITM6",98,0) W:'$D(ZTQUEUED) !!,$S(PRCFATAL:"",1:"") "RTN","PRCHITM6",99,0) K PRCLFDIR,PRCLFFILE "RTN","PRCHITM6",100,0) Q "RTN","PRCHITM6",101,0) INITLOG(PRCTXNID) ; Initialize error log "RTN","PRCHITM6",102,0) N PRCDT,X1,X2,X,%H "RTN","PRCHITM6",103,0) S PRCERRC=0,PRCHNODE="PRCHITM6;"_PRCTXNID K ^XTMP(PRCHNODE) "RTN","PRCHITM6",104,0) ; Setting up ^XTMP header node including automatic purge date "RTN","PRCHITM6",105,0) S PRCDT=$$DT^XLFDT,X1=PRCDT,X2=30 D C^%DTC S ^XTMP(PRCHNODE,0)=X_"^"_PRCDT_"^"_"IFCAP MANUFACTURER LOAD" "RTN","PRCHITM6",106,0) Q "RTN","PRCHITM6",107,0) LOGERR(PRCE,PRCID) ; Record errors "RTN","PRCHITM6",108,0) N PRCI,PRCK,PRCM S PRCK=$P($G(PRCERR("DIERR")),"^") Q:+PRCK'>0 "RTN","PRCHITM6",109,0) F PRCI=1:1:PRCK D "RTN","PRCHITM6",110,0) . S PRCM=$G(PRCE("DIERR",PRCI,"TEXT",1)) I PRCM'="" S PRCM="ID Number:"_PRCID_": "_PRCM "RTN","PRCHITM6",111,0) . S PRCERRC=PRCERRC+1 S ^XTMP(PRCHNODE,"ERR",PRCERRC)=PRCM "RTN","PRCHITM6",112,0) Q "RTN","PRCHITM6",113,0) ; "RTN","PRCHITM6",114,0) ; "RTN","PRCHITM6",115,0) ; Send e-mails with error messages "RTN","PRCHITM6",116,0) SEND(PRCA,PRCB,PRCC,PRCD,PRCE) ; "RTN","PRCHITM6",117,0) N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ "RTN","PRCHITM6",118,0) S XMSUB="Stn "_PRCE_" Errors Manufacturer Load File "_PRCB_" Msg #"_PRCC_" of "_PRCD "RTN","PRCHITM6",119,0) S XMDUZ=.5,XMTEXT="PRCA(",XMY("G.ISM")="",XMY(DUZ)="" "RTN","PRCHITM6",120,0) S:$$PROD^XUPROD() XMY("VHANIFMO@domain.ext")="" "RTN","PRCHITM6",121,0) D ^XMD "RTN","PRCHITM6",122,0) Q "RTN","PRCHITM6",123,0) ; "RTN","PRCHITM6",124,0) ;PRCHITM6 "VER") 8.0^22.2 "BLD",7714,6) ^198 **END** **END**