PRCPLO3 ;WOIFO/DAP/RLL-manual run option for GIP reports ; 7/28/06 10:39am
V ;;5.1;IFCAP;**83,98**;Oct 20, 2000;Build 37
;Per VHA Directive 2004-038, this routine should not be modified.
;
ENT ;This section of the routine executes calls to the separate CLRS GIP
;extract routines.
;
N ZTRTN,ZTDESC,ZTDTH,ZTIO,PRCPSSR,ZTSK,ZTREQ,PRCPMSG
S ZTRTN="ENT^PRCPLO2"
S ZTDESC="PRCPLO CLO GIP Reports CLRS"
S ZTDTH=$H
S ZTREQ="@"
S ZTIO=""
D ^%ZTLOAD
S PRCPSSR=ZTSK
; Calls mail group message generation and screen display with success
; or exception notification
I $D(PRCPSSR)[0 S PRCPMSG(1)="A task could not be created for the CLO GIP Reports - please contact IRM." D MAIL W ! D EN^DDIOL(PRCPMSG(1)) Q
;
S PRCPMSG(1)="Task # "_PRCPSSR_" entered for the CLO GIP Reports."
W !
D EN^DDIOL(PRCPMSG(1))
D MAIL
;
Q
;
MAIL ; Builds mail messages to a defined mail group to notify users of the
; success or failure of the TaskMan scheduling for the CLO GIP Reports.
;
;*98 Modified code to work with PRC CLRS OUTLOOK MAILGROUP parameter
N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ,PRCPMG,PRCPMG2
S XMSUB="CLO GIP Report Status for "_$$HTE^XLFDT($H)
S XMDUZ="Clinical Logistics Report Server"
S XMTEXT="PRCPMSG("
S XMY("G.PRCPLO CLRS NOTIFICATIONS")=""
S PRCPMG=$$GET^XPAR("SYS","PRC CLRS OUTLOOK MAILGROUP",1,"Q")
S:$G(PRCPMG)'="" PRCPMG2="S XMY("""_PRCPMG_""")=""""" X PRCPMG2
;
D ^XMD
Q
;
BLDGP2 ; Build the DAYS of stock on hand file
N FILEDIR,STID,FILG2
S FILEDIR=$$GET^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,"Q")
S STID=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)
S FILG2="IFCP"_STID_"G2.TXT"
D OPEN^%ZISH("FILE1",FILEDIR,FILG2,"W")
; D OPEN^%ZISH("FILE1",FILEDIR,"CLRSG2.TXT","W")
D USE^%ZISUTL("FILE1")
D GTGIPSOH ; *98 New version
D GTGIPSOD ; *98 New version
D CLOSE^%ZISH("FILE1")
Q
BLDGP1 ; BUILD THE stock status file
N FILEDIR,STID,FILG1
S FILEDIR=$$GET^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,"Q")
S STID=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)
S FILG1="IFCP"_STID_"G1.TXT"
D OPEN^%ZISH("FILE1",FILEDIR,FILG1,"W")
; D OPEN^%ZISH("FILE1",FILEDIR,"CLRSG1.DAT","W")
D USE^%ZISUTL("FILE1")
; D GETGIPH2
; D GETGIPSF
D GTGIPSSH ; *98, New version
D GTGIPSSD ; *98, New version
D CLOSE^%ZISH("FILE1")
Q
GETGIPSF ; Get the GIP stock status data from file 446.7 (old format)
N GT1,GT2,GT3,GT4
S GT1="",GT2="",GT3=""
F S GT1=$O(^PRCP(446.7,GT1)) Q:GT1="" D
. S GT2=$G(^PRCP(446.7,GT1,2))
. I $P(GT2,"*",2)'="" W GT2,!
. Q
Q
GTGIPSOD ; *98 Get the GIP Stock on Hand Data new (new format)
;
N GT1,GT2,DT3
S GT1="",GT2="",DT3=""
F S GT1=$O(^PRCP(446.7,GT1)) Q:GT1="" D
. S GT2=$G(^PRCP(446.7,GT1,1))_"*"
. S DT3=$G(^PRCP(446.7,GT1,2))
. I $P(GT2,"*",2)'="" W !,GT2,DT3
. Q
Q
GTGIPSSD ; *98 Get GIP Stock Status data (new format)
N GT1,GT2,DT3,DT4,DT5,DT6,DT7
S GT1="",GT2="",DT3="",DT4="",DT5="",DT6="",DT7=""
F S GT1=$O(^PRCP(446.7,GT1)) Q:GT1="" D
. S GT2=$G(^PRCP(446.7,GT1,3))_"*"
. S DT4=$G(^PRCP(446.7,GT1,4))_"*"
. S DT5=$G(^PRCP(446.7,GT1,5))_"*"
. S DT6=$G(^PRCP(446.7,GT1,6))_"*"
. S DT7=$G(^PRCP(446.7,GT1,7))
. I $P(GT2,"*",2)'="" W !,GT2,DT4,DT5,DT6,DT7
. Q
Q
GETGIPH1 ; Header for stock on hand report (old format)
;
W "StationNum"_"*"_"DateRange"_"*"_"InvIdNum"_"*"
W "InventoryPoint"_"*"_"InventoryType"_"*"_"TotalDollars"_"*"
W "NumOfLineItemsSoh"_"*"_"NumOfLineItemsInv"_"*"_"CostCenter",!
Q
GTGIPSOH ; *98 Header for stock on hand report (new format)
;
W "StationNum"_"*"_"DateRange"_"*"_"InvIdNum"_"*"
W "InventoryPoint"_"*"_"InventoryType"_"*"_"TotalDollars"_"*"
W "NumOfLineItemsSoh"_"*"_"NumOfLineItemsInv"_"*"_"CostCenter"_"*"
W "StdTotDolVal"_"*"_"OdiTotDolVal"_"*"_"AllTotDolVal"_"*"
W "StdNumSohItems"_"*"_"OdiNumSohItems"_"*"_"AllNumSohItems"_"*"
W "StdNumInvItems"_"*"_"OdiNumInvItems"_"*"_"AllNumInvItems"
Q
GETGIPH2 ; Header for Stock Status Report
W "StationNum"_"*"_"DateRange"_"*"_"NumDays"_"*"
W "InvIdNum"_"*"_"InventoryPoint"_"*"_"InventoryType"_"*"_"OpenBalTotal"_"*"_"ReceiptsTot"_"*"
W "IssuesTotal"_"*"_"AdjTotal"_"*"_"ClosingBalTot"_"*"
W "ReceiptsTot#"_"*"_"IssuesTotal#"_"*"_"AdjTotal#"_"*"
W "TurnoverTotal"_"*"_"InactiveItmTotal#"_"*"_"InactiveItemTotal$"
W "*"_"InactiveItemsPct"_"*"_"LongSupplyTotal#"_"*"_"LongSupplyTotal$"
W "*"_"LongSupplyPct"_"*"_"NumOfLineItemsInv",!
Q
GETGIPF ; Get the GIP days of stock on hand data from File 446.7 (old format)
;
N GP1,GP2,GP3
S GP1=0,GP2=0,GP3=0
F S GP1=$O(^PRCP(446.7,GP1)) Q:GP1="" D
. S GP2=$G(^PRCP(446.7,GP1,1))
. I $P(GP2,"*",1)'="" W GP2,!
. Q
Q
GTGIPSSH ; *98 NEW Stock Status Report Header
; Additional Fields were added to accommodate
; Standard Items and On Demand Items
W "StNum"_"*"_"DtRng"_"*"_"NmDys"_"*"
W "InvIdNum"_"*"_"InvPnt"_"*"_"InvTyp"_"*"
W "StdOpnBalTot"_"*"_"OdiOpnBalTot"_"*"_"AllOpnBalTot"_"*"
W "StdRcptsTot"_"*"_"OdiRcptsTot"_"*"_"AllRcptsTot"_"*"
W "StdIssTot"_"*"_"OdiIssTot"_"*"_"AllIssTot"_"*"
W "StdAdjTot"_"*"_"OdiAdjTot"_"*"_"AllAdjTot"_"*"
W "StdClseBalTot"_"*"_"OdiClseBalTot"_"*"_"AllClseBalTo"_"*"
W "NumStdRcpts"_"*"_"NumOdiRcpts"_"*"_"NumAllRcpts"_"*"
W "NumStdIss"_"*"_"NumOdiIss"_"*"_"NumAllIss"_"*"
W "NumStdAdj"_"*"_"NumOdiAdj"_"*"_"NumAllAdj"_"*"
W "StdTrnvrTot"_"*"_"OdiTrnvrTot"_"*"_"AllTrnvrTot"_"*"
W "NumStdInactItms"_"*"_"NumOdiInactItms"_"*"_"NumAllInactItms"_"*"
W "StdInactTotDol"_"*"_"OdiInactTotDol"_"*"_"AllInactTotDol"_"*"
W "StdInactPct"_"*"_"OdiInactPct"_"*"_"AllInactPct"_"*"
;
W "StdNumLngSup"_"*"_"OdiNumLngSup"_"*"_"AllNumLngSup"_"*"
W "StdLngSupTotDol"_"*"_"OdiLngSupTotDol"_"*"_"AllLngSupTotDol"_"*"
W "StdLngSupPct"_"*"_"OdiLngSupPct"_"*"_"AllLngSupPct"_"*"
W "NumStdInvLnItms"_"*"_"NumOdiInvLnItms"_"*"_"NumAllInvLnItms"
;
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPLO3 5879 printed Sep 23, 2025@19:50:12 Page 2
PRCPLO3 ;WOIFO/DAP/RLL-manual run option for GIP reports ; 7/28/06 10:39am
V ;;5.1;IFCAP;**83,98**;Oct 20, 2000;Build 37
+1 ;Per VHA Directive 2004-038, this routine should not be modified.
+2 ;
ENT ;This section of the routine executes calls to the separate CLRS GIP
+1 ;extract routines.
+2 ;
+3 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,PRCPSSR,ZTSK,ZTREQ,PRCPMSG
+4 SET ZTRTN="ENT^PRCPLO2"
+5 SET ZTDESC="PRCPLO CLO GIP Reports CLRS"
+6 SET ZTDTH=$HOROLOG
+7 SET ZTREQ="@"
+8 SET ZTIO=""
+9 DO ^%ZTLOAD
+10 SET PRCPSSR=ZTSK
+11 ; Calls mail group message generation and screen display with success
+12 ; or exception notification
+13 IF $DATA(PRCPSSR)[0
SET PRCPMSG(1)="A task could not be created for the CLO GIP Reports - please contact IRM."
DO MAIL
WRITE !
DO EN^DDIOL(PRCPMSG(1))
QUIT
+14 ;
+15 SET PRCPMSG(1)="Task # "_PRCPSSR_" entered for the CLO GIP Reports."
+16 WRITE !
+17 DO EN^DDIOL(PRCPMSG(1))
+18 DO MAIL
+19 ;
+20 QUIT
+21 ;
MAIL ; Builds mail messages to a defined mail group to notify users of the
+1 ; success or failure of the TaskMan scheduling for the CLO GIP Reports.
+2 ;
+3 ;*98 Modified code to work with PRC CLRS OUTLOOK MAILGROUP parameter
+4 NEW XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ,PRCPMG,PRCPMG2
+5 SET XMSUB="CLO GIP Report Status for "_$$HTE^XLFDT($HOROLOG)
+6 SET XMDUZ="Clinical Logistics Report Server"
+7 SET XMTEXT="PRCPMSG("
+8 SET XMY("G.PRCPLO CLRS NOTIFICATIONS")=""
+9 SET PRCPMG=$$GET^XPAR("SYS","PRC CLRS OUTLOOK MAILGROUP",1,"Q")
+10 if $GET(PRCPMG)'=""
SET PRCPMG2="S XMY("""_PRCPMG_""")="""""
XECUTE PRCPMG2
+11 ;
+12 DO ^XMD
+13 QUIT
+14 ;
BLDGP2 ; Build the DAYS of stock on hand file
+1 NEW FILEDIR,STID,FILG2
+2 SET FILEDIR=$$GET^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,"Q")
+3 SET STID=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)
+4 SET FILG2="IFCP"_STID_"G2.TXT"
+5 DO OPEN^%ZISH("FILE1",FILEDIR,FILG2,"W")
+6 ; D OPEN^%ZISH("FILE1",FILEDIR,"CLRSG2.TXT","W")
+7 DO USE^%ZISUTL("FILE1")
+8 ; *98 New version
DO GTGIPSOH
+9 ; *98 New version
DO GTGIPSOD
+10 DO CLOSE^%ZISH("FILE1")
+11 QUIT
BLDGP1 ; BUILD THE stock status file
+1 NEW FILEDIR,STID,FILG1
+2 SET FILEDIR=$$GET^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,"Q")
+3 SET STID=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)
+4 SET FILG1="IFCP"_STID_"G1.TXT"
+5 DO OPEN^%ZISH("FILE1",FILEDIR,FILG1,"W")
+6 ; D OPEN^%ZISH("FILE1",FILEDIR,"CLRSG1.DAT","W")
+7 DO USE^%ZISUTL("FILE1")
+8 ; D GETGIPH2
+9 ; D GETGIPSF
+10 ; *98, New version
DO GTGIPSSH
+11 ; *98, New version
DO GTGIPSSD
+12 DO CLOSE^%ZISH("FILE1")
+13 QUIT
GETGIPSF ; Get the GIP stock status data from file 446.7 (old format)
+1 NEW GT1,GT2,GT3,GT4
+2 SET GT1=""
SET GT2=""
SET GT3=""
+3 FOR
SET GT1=$ORDER(^PRCP(446.7,GT1))
if GT1=""
QUIT
Begin DoDot:1
+4 SET GT2=$GET(^PRCP(446.7,GT1,2))
+5 IF $PIECE(GT2,"*",2)'=""
WRITE GT2,!
+6 QUIT
End DoDot:1
+7 QUIT
GTGIPSOD ; *98 Get the GIP Stock on Hand Data new (new format)
+1 ;
+2 NEW GT1,GT2,DT3
+3 SET GT1=""
SET GT2=""
SET DT3=""
+4 FOR
SET GT1=$ORDER(^PRCP(446.7,GT1))
if GT1=""
QUIT
Begin DoDot:1
+5 SET GT2=$GET(^PRCP(446.7,GT1,1))_"*"
+6 SET DT3=$GET(^PRCP(446.7,GT1,2))
+7 IF $PIECE(GT2,"*",2)'=""
WRITE !,GT2,DT3
+8 QUIT
End DoDot:1
+9 QUIT
GTGIPSSD ; *98 Get GIP Stock Status data (new format)
+1 NEW GT1,GT2,DT3,DT4,DT5,DT6,DT7
+2 SET GT1=""
SET GT2=""
SET DT3=""
SET DT4=""
SET DT5=""
SET DT6=""
SET DT7=""
+3 FOR
SET GT1=$ORDER(^PRCP(446.7,GT1))
if GT1=""
QUIT
Begin DoDot:1
+4 SET GT2=$GET(^PRCP(446.7,GT1,3))_"*"
+5 SET DT4=$GET(^PRCP(446.7,GT1,4))_"*"
+6 SET DT5=$GET(^PRCP(446.7,GT1,5))_"*"
+7 SET DT6=$GET(^PRCP(446.7,GT1,6))_"*"
+8 SET DT7=$GET(^PRCP(446.7,GT1,7))
+9 IF $PIECE(GT2,"*",2)'=""
WRITE !,GT2,DT4,DT5,DT6,DT7
+10 QUIT
End DoDot:1
+11 QUIT
GETGIPH1 ; Header for stock on hand report (old format)
+1 ;
+2 WRITE "StationNum"_"*"_"DateRange"_"*"_"InvIdNum"_"*"
+3 WRITE "InventoryPoint"_"*"_"InventoryType"_"*"_"TotalDollars"_"*"
+4 WRITE "NumOfLineItemsSoh"_"*"_"NumOfLineItemsInv"_"*"_"CostCenter",!
+5 QUIT
GTGIPSOH ; *98 Header for stock on hand report (new format)
+1 ;
+2 WRITE "StationNum"_"*"_"DateRange"_"*"_"InvIdNum"_"*"
+3 WRITE "InventoryPoint"_"*"_"InventoryType"_"*"_"TotalDollars"_"*"
+4 WRITE "NumOfLineItemsSoh"_"*"_"NumOfLineItemsInv"_"*"_"CostCenter"_"*"
+5 WRITE "StdTotDolVal"_"*"_"OdiTotDolVal"_"*"_"AllTotDolVal"_"*"
+6 WRITE "StdNumSohItems"_"*"_"OdiNumSohItems"_"*"_"AllNumSohItems"_"*"
+7 WRITE "StdNumInvItems"_"*"_"OdiNumInvItems"_"*"_"AllNumInvItems"
+8 QUIT
GETGIPH2 ; Header for Stock Status Report
+1 WRITE "StationNum"_"*"_"DateRange"_"*"_"NumDays"_"*"
+2 WRITE "InvIdNum"_"*"_"InventoryPoint"_"*"_"InventoryType"_"*"_"OpenBalTotal"_"*"_"ReceiptsTot"_"*"
+3 WRITE "IssuesTotal"_"*"_"AdjTotal"_"*"_"ClosingBalTot"_"*"
+4 WRITE "ReceiptsTot#"_"*"_"IssuesTotal#"_"*"_"AdjTotal#"_"*"
+5 WRITE "TurnoverTotal"_"*"_"InactiveItmTotal#"_"*"_"InactiveItemTotal$"
+6 WRITE "*"_"InactiveItemsPct"_"*"_"LongSupplyTotal#"_"*"_"LongSupplyTotal$"
+7 WRITE "*"_"LongSupplyPct"_"*"_"NumOfLineItemsInv",!
+8 QUIT
GETGIPF ; Get the GIP days of stock on hand data from File 446.7 (old format)
+1 ;
+2 NEW GP1,GP2,GP3
+3 SET GP1=0
SET GP2=0
SET GP3=0
+4 FOR
SET GP1=$ORDER(^PRCP(446.7,GP1))
if GP1=""
QUIT
Begin DoDot:1
+5 SET GP2=$GET(^PRCP(446.7,GP1,1))
+6 IF $PIECE(GP2,"*",1)'=""
WRITE GP2,!
+7 QUIT
End DoDot:1
+8 QUIT
GTGIPSSH ; *98 NEW Stock Status Report Header
+1 ; Additional Fields were added to accommodate
+2 ; Standard Items and On Demand Items
+3 WRITE "StNum"_"*"_"DtRng"_"*"_"NmDys"_"*"
+4 WRITE "InvIdNum"_"*"_"InvPnt"_"*"_"InvTyp"_"*"
+5 WRITE "StdOpnBalTot"_"*"_"OdiOpnBalTot"_"*"_"AllOpnBalTot"_"*"
+6 WRITE "StdRcptsTot"_"*"_"OdiRcptsTot"_"*"_"AllRcptsTot"_"*"
+7 WRITE "StdIssTot"_"*"_"OdiIssTot"_"*"_"AllIssTot"_"*"
+8 WRITE "StdAdjTot"_"*"_"OdiAdjTot"_"*"_"AllAdjTot"_"*"
+9 WRITE "StdClseBalTot"_"*"_"OdiClseBalTot"_"*"_"AllClseBalTo"_"*"
+10 WRITE "NumStdRcpts"_"*"_"NumOdiRcpts"_"*"_"NumAllRcpts"_"*"
+11 WRITE "NumStdIss"_"*"_"NumOdiIss"_"*"_"NumAllIss"_"*"
+12 WRITE "NumStdAdj"_"*"_"NumOdiAdj"_"*"_"NumAllAdj"_"*"
+13 WRITE "StdTrnvrTot"_"*"_"OdiTrnvrTot"_"*"_"AllTrnvrTot"_"*"
+14 WRITE "NumStdInactItms"_"*"_"NumOdiInactItms"_"*"_"NumAllInactItms"_"*"
+15 WRITE "StdInactTotDol"_"*"_"OdiInactTotDol"_"*"_"AllInactTotDol"_"*"
+16 WRITE "StdInactPct"_"*"_"OdiInactPct"_"*"_"AllInactPct"_"*"
+17 ;
+18 WRITE "StdNumLngSup"_"*"_"OdiNumLngSup"_"*"_"AllNumLngSup"_"*"
+19 WRITE "StdLngSupTotDol"_"*"_"OdiLngSupTotDol"_"*"_"AllLngSupTotDol"_"*"
+20 WRITE "StdLngSupPct"_"*"_"OdiLngSupPct"_"*"_"AllLngSupPct"_"*"
+21 WRITE "NumStdInvLnItms"_"*"_"NumOdiInvLnItms"_"*"_"NumAllInvLnItms"
+22 ;
+23 ;
+24 QUIT
