- PRCHITX1 ;WOIFO/LKG-WRITING ITEM DATA FOR NIF TO DAT FILES ;12/27/04 17:58
- ;;5.1;IFCAP;**75**;OCT 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- START ;Writes .dat file of vendor and item information to host file
- D EN^DDIOL("This option writes item information to the .dat file.")
- D EN^DDIOL("It is recommended to queue this extract for a time of low user activity.",,"!!")
- N %ZIS,ZTRTN,ZTDESC,PRCPHYS
- K Y,DIR S DIR(0)="Y",DIR("A")="Include physical inventory count transactions in the analysis",DIR("B")="NO"
- S DIR("?",1)="Answer 'YES' if you have a large number of items that have recently been"
- S DIR("?",2)="added to your GIP inventory, but have not yet been received or issued."
- S DIR("?")="Answer 'NO' to exclude slow moving stock from NIF processing."
- D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) G ITX
- S PRCPHYS=$S(Y=1:"Y",1:"N") K Y
- S %ZIS="Q",%ZIS("A")="Host File Device: ",%ZIS("B")="PRC_WIDE_HOST_FILE"
- D ^%ZIS G:POP ITX
- I $D(IO("Q")) D Q
- . S ZTRTN="COMPILE^PRCHITX1",ZTDESC="Item Extraction for NIF",ZTSAVE("PRCPHYS")=""
- . D ^%ZTLOAD,HOME^%ZIS
- . D EN^DDIOL("Task #"_ZTSK) K IO("Q"),ZTSK
- COMPILE ;invoke the item and vendor compile
- N X,Y,PRCSTA,PRCV,PRCW,PRCX,PRCY,PRCZ
- D IN^PRCHITX
- S PRCSTA=$$GETSTATN^PRCHITX
- U IO
- VENDOR ;Write vendor data
- S PRCX=""
- F S PRCX=$O(^TMP($J,"V",PRCX)) Q:PRCX="" D
- . S PRCY=$G(^TMP($J,"V",PRCX)) Q:PRCY=""
- . S PRCZ="6^9^"_PRCSTA_"^"_PRCX_"^"_$P(PRCY,"^")_"^"_$P(PRCY,"^",4)_"^"_$P(PRCY,"^",3)_"^"_$P(PRCY,"^",2)_"^"_$P(PRCY,"^",5)
- . W PRCZ,!
- ITEM ;Write item data
- S PRCX=""
- F S PRCX=$O(^TMP($J,"I",PRCX)) Q:PRCX="" D
- . S PRCY=$G(^TMP($J,"I",PRCX,0)) Q:PRCY=""
- . S PRCZ="6^0^"_PRCSTA_"^"_$P(PRCY,"^",8)_"^"_PRCX_"^"_$$GETSDESC^PRCHITX(PRCX)_"^"
- . W PRCZ
- . S X=0,Y=1
- . F S X=$O(^PRC(441,PRCX,1,X)) Q:X="" D
- . . S PRCZ=$G(^PRC(441,PRCX,1,X,0)),PRCZ=$TR(PRCZ,"^") Q:PRCZ=""
- . . W:Y>1 " " W PRCZ S Y=Y+1
- . S PRCZ="^^"_$P(PRCY,"^",6)_"^"_$P(PRCY,"^",4)_"^" W PRCZ
- . S PRCW=$G(^TMP($J,"I",PRCX,1)),PRCV=$P(PRCW,"^")
- . S PRCZ=$P(PRCY,"^",5)_"^^"_PRCV_"^^^^"_$P(PRCW,"^",4)_"^0^"_$P(PRCW,"^",2)_"^"_$P(PRCW,"^",3)_"^"
- . W PRCZ
- . S PRCZ=$P(PRCY,"^",3)_"^"_$P(PRCW,"^",6)_"^^"_$P(PRCW,"^",5)
- . W PRCZ,!
- D ^%ZISC
- S:$D(ZTQUEUED) ZTREQ="@"
- D:'$D(ZTQUEUED) EN^DDIOL("<DONE>")
- K PRCW,PRCX,PRCY,PRCZ S PRCW=$$KSP^XUPARAM("WHERE")
- K XMZ,XMMG,XMDUZ,XMY,XMSUB,XMTEXT
- S PRCX(1)="Record counts for NIF Item Extract File from Station "_PRCSTA
- S PRCX(2)=" "
- S PRCX(3)=" Number of items: "_$G(^TMP($J,"I"),0)
- S PRCX(4)=" Number of vendors: "_$G(^TMP($J,"V"),0)
- S PRCX(5)=" ",PRCX(6)="Physical count transactions were "_$S(PRCPHYS="Y":"",1:"not ")_"included in the analysis."
- X ^%ZOSF("UCI") S PRCY=^%ZOSF("PROD") S:PRCY'["," Y=$P(Y,",")
- I Y=PRCY,PRCW'["FO-",PRCW'["ISC-" S XMY("prchitem@domain.ext")=""
- I $G(DUZ)>0,$D(^VA(200,DUZ)) D
- . N PRCNAME
- . S XMY(DUZ)=""
- . S PRCNAME("FILE")=200,PRCNAME("IENS")=DUZ_",",PRCNAME("FIELD")=.01
- . S PRCX(7)=" ",PRCX(8)="The extraction process was run by "_$$NAMEFMT^XLFNAME(.PRCNAME,"G","M")_"."
- S XMSUB="NIF Item Extract Statistics for Station "_PRCSTA
- S XMDUZ="NIF ITEM EXTRACTOR"
- S XMTEXT="PRCX(" D ^XMD
- I $G(XMZ),'$D(ZTQUEUED) D EN^DDIOL("MailMan message #"_$G(XMZ)_" with extract statistics was sent.")
- K XMZ,XMMG,XMDUZ,XMY,XMSUB,XMTEXT,PRCPHYS
- ITX ;EXIT
- K POP,^TMP($J),DTOUT,DUOUT,DIRUT,DIROUT,Y
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHITX1 3445 printed Mar 13, 2025@21:12:55 Page 2
- PRCHITX1 ;WOIFO/LKG-WRITING ITEM DATA FOR NIF TO DAT FILES ;12/27/04 17:58
- +1 ;;5.1;IFCAP;**75**;OCT 20, 2000
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- START ;Writes .dat file of vendor and item information to host file
- +1 DO EN^DDIOL("This option writes item information to the .dat file.")
- +2 DO EN^DDIOL("It is recommended to queue this extract for a time of low user activity.",,"!!")
- +3 NEW %ZIS,ZTRTN,ZTDESC,PRCPHYS
- +4 KILL Y,DIR
- SET DIR(0)="Y"
- SET DIR("A")="Include physical inventory count transactions in the analysis"
- SET DIR("B")="NO"
- +5 SET DIR("?",1)="Answer 'YES' if you have a large number of items that have recently been"
- +6 SET DIR("?",2)="added to your GIP inventory, but have not yet been received or issued."
- +7 SET DIR("?")="Answer 'NO' to exclude slow moving stock from NIF processing."
- +8 DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
- GOTO ITX
- +9 SET PRCPHYS=$SELECT(Y=1:"Y",1:"N")
- KILL Y
- +10 SET %ZIS="Q"
- SET %ZIS("A")="Host File Device: "
- SET %ZIS("B")="PRC_WIDE_HOST_FILE"
- +11 DO ^%ZIS
- if POP
- GOTO ITX
- +12 IF $DATA(IO("Q"))
- Begin DoDot:1
- +13 SET ZTRTN="COMPILE^PRCHITX1"
- SET ZTDESC="Item Extraction for NIF"
- SET ZTSAVE("PRCPHYS")=""
- +14 DO ^%ZTLOAD
- DO HOME^%ZIS
- +15 DO EN^DDIOL("Task #"_ZTSK)
- KILL IO("Q"),ZTSK
- End DoDot:1
- QUIT
- COMPILE ;invoke the item and vendor compile
- +1 NEW X,Y,PRCSTA,PRCV,PRCW,PRCX,PRCY,PRCZ
- +2 DO IN^PRCHITX
- +3 SET PRCSTA=$$GETSTATN^PRCHITX
- +4 USE IO
- VENDOR ;Write vendor data
- +1 SET PRCX=""
- +2 FOR
- SET PRCX=$ORDER(^TMP($JOB,"V",PRCX))
- if PRCX=""
- QUIT
- Begin DoDot:1
- +3 SET PRCY=$GET(^TMP($JOB,"V",PRCX))
- if PRCY=""
- QUIT
- +4 SET PRCZ="6^9^"_PRCSTA_"^"_PRCX_"^"_$PIECE(PRCY,"^")_"^"_$PIECE(PRCY,"^",4)_"^"_$PIECE(PRCY,"^",3)_"^"_$PIECE(PRCY,"^",2)_"^"_$PIECE(PRCY,"^",5)
- +5 WRITE PRCZ,!
- End DoDot:1
- ITEM ;Write item data
- +1 SET PRCX=""
- +2 FOR
- SET PRCX=$ORDER(^TMP($JOB,"I",PRCX))
- if PRCX=""
- QUIT
- Begin DoDot:1
- +3 SET PRCY=$GET(^TMP($JOB,"I",PRCX,0))
- if PRCY=""
- QUIT
- +4 SET PRCZ="6^0^"_PRCSTA_"^"_$PIECE(PRCY,"^",8)_"^"_PRCX_"^"_$$GETSDESC^PRCHITX(PRCX)_"^"
- +5 WRITE PRCZ
- +6 SET X=0
- SET Y=1
- +7 FOR
- SET X=$ORDER(^PRC(441,PRCX,1,X))
- if X=""
- QUIT
- Begin DoDot:2
- +8 SET PRCZ=$GET(^PRC(441,PRCX,1,X,0))
- SET PRCZ=$TRANSLATE(PRCZ,"^")
- if PRCZ=""
- QUIT
- +9 if Y>1
- WRITE " "
- WRITE PRCZ
- SET Y=Y+1
- End DoDot:2
- +10 SET PRCZ="^^"_$PIECE(PRCY,"^",6)_"^"_$PIECE(PRCY,"^",4)_"^"
- WRITE PRCZ
- +11 SET PRCW=$GET(^TMP($JOB,"I",PRCX,1))
- SET PRCV=$PIECE(PRCW,"^")
- +12 SET PRCZ=$PIECE(PRCY,"^",5)_"^^"_PRCV_"^^^^"_$PIECE(PRCW,"^",4)_"^0^"_$PIECE(PRCW,"^",2)_"^"_$PIECE(PRCW,"^",3)_"^"
- +13 WRITE PRCZ
- +14 SET PRCZ=$PIECE(PRCY,"^",3)_"^"_$PIECE(PRCW,"^",6)_"^^"_$PIECE(PRCW,"^",5)
- +15 WRITE PRCZ,!
- End DoDot:1
- +16 DO ^%ZISC
- +17 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +18 if '$DATA(ZTQUEUED)
- DO EN^DDIOL("<DONE>")
- +19 KILL PRCW,PRCX,PRCY,PRCZ
- SET PRCW=$$KSP^XUPARAM("WHERE")
- +20 KILL XMZ,XMMG,XMDUZ,XMY,XMSUB,XMTEXT
- +21 SET PRCX(1)="Record counts for NIF Item Extract File from Station "_PRCSTA
- +22 SET PRCX(2)=" "
- +23 SET PRCX(3)=" Number of items: "_$GET(^TMP($JOB,"I"),0)
- +24 SET PRCX(4)=" Number of vendors: "_$GET(^TMP($JOB,"V"),0)
- +25 SET PRCX(5)=" "
- SET PRCX(6)="Physical count transactions were "_$SELECT(PRCPHYS="Y":"",1:"not ")_"included in the analysis."
- +26 XECUTE ^%ZOSF("UCI")
- SET PRCY=^%ZOSF("PROD")
- if PRCY'[","
- SET Y=$PIECE(Y,",")
- +27 IF Y=PRCY
- IF PRCW'["FO-"
- IF PRCW'["ISC-"
- SET XMY("prchitem@domain.ext")=""
- +28 IF $GET(DUZ)>0
- IF $DATA(^VA(200,DUZ))
- Begin DoDot:1
- +29 NEW PRCNAME
- +30 SET XMY(DUZ)=""
- +31 SET PRCNAME("FILE")=200
- SET PRCNAME("IENS")=DUZ_","
- SET PRCNAME("FIELD")=.01
- +32 SET PRCX(7)=" "
- SET PRCX(8)="The extraction process was run by "_$$NAMEFMT^XLFNAME(.PRCNAME,"G","M")_"."
- End DoDot:1
- +33 SET XMSUB="NIF Item Extract Statistics for Station "_PRCSTA
- +34 SET XMDUZ="NIF ITEM EXTRACTOR"
- +35 SET XMTEXT="PRCX("
- DO ^XMD
- +36 IF $GET(XMZ)
- IF '$DATA(ZTQUEUED)
- DO EN^DDIOL("MailMan message #"_$GET(XMZ)_" with extract statistics was sent.")
- +37 KILL XMZ,XMMG,XMDUZ,XMY,XMSUB,XMTEXT,PRCPHYS
- ITX ;EXIT
- +1 KILL POP,^TMP($JOB),DTOUT,DUOUT,DIRUT,DIROUT,Y
- +2 QUIT
