PRCPAGU1 ;WISC/RFJ-autogenerate utilities ;01 Dec 92
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
DELTEMP(V1,V2) ; delete temp stock level for invpt v1, item v2
I '$D(^PRCP(445,+V1,1,+V2,0)) Q
N D0,DA,DIE,DR,X,Y
S V1=+V1,V2=+V2,DIE="^PRCP(445,"_V1_",1,",DA(1)=V1,DA=V2,DR="9.5///@;9.6///@" D ^DIE Q
;
;
OPTIONAL ; check for vendors with items only at optional reorder point
; do not order optional reorder point if vendor not ordering
; using standard reorder point
N DESCNSN,GNM,ITEMDA,VDA,VNM
S VNM="" F S VNM=$O(^TMP($J,"PRCPAG","OK",VNM)) Q:VNM="" S VDA=0 F S VDA=$O(^TMP($J,"PRCPAG","OK",VNM,VDA)) Q:'VDA I '$D(^TMP($J,"PRCPAG","V+",VDA,"STA")) D
. S GNM="" F S GNM=$O(^TMP($J,"PRCPAG","OK",VNM,VDA,GNM)) Q:GNM="" S DESCNSN="" F S DESCNSN=$O(^TMP($J,"PRCPAG","OK",VNM,VDA,GNM,DESCNSN)) Q:DESCNSN="" D
. . S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPAG","OK",VNM,VDA,GNM,DESCNSN,ITEMDA)) Q:'ITEMDA S ^TMP($J,"PRCPAG","NOT",VNM,VDA,GNM,DESCNSN,ITEMDA)=^TMP($J,"PRCPAG","OK",VNM,VDA,GNM,DESCNSN,ITEMDA),TOTITEMS=TOTITEMS-1
. K ^TMP($J,"PRCPAG","OK",VNM,VDA)
Q
;
;
REPORTS ; ask to print reports
N %,PRCPERR,PRCPFLAG,PRCPNOG,PRCPNOV,PRCPNOT
I $O(^TMP($J,"PRCPAG","ER",""))'="" D Q:$G(PRCPFLAG)
. S XP="Do you want to print errors occurring during auto-generation",XH="Enter 'YES' to print the error report, 'NO' to skip printing it, '^' to exit."
. W ! S %=$$YN^PRCPUYN(1)
. I %=2 Q
. I %=1 S PRCPERR=1 Q
. S PRCPFLAG=1
I $O(^TMP($J,"PRCPAG","NOV",""))'="" D Q:$G(PRCPFLAG)
. S XP="Do you want to print items with vendors not selected",XH="Enter 'YES' to print items with vendors not selected report,",XH(1)=" 'NO' to skip printing it, '^' to exit."
. W ! S %=$$YN^PRCPUYN(1)
. I %=2 Q
. I %=1 S PRCPNOV=1 Q
. S PRCPFLAG=1
I $O(^TMP($J,"PRCPAG","NOG",""))'="" D Q:$G(PRCPFLAG)
. S XP="Do you want to print items with groups not selected",XH="Enter 'YES' to print items with groups not selected report,",XH(1)=" 'NO' to skip printing it, '^' to exit."
. W ! S %=$$YN^PRCPUYN(1)
. I %=2 Q
. I %=1 S PRCPNOG=1 Q
. S PRCPFLAG=1
I $O(^TMP($J,"PRCPAG","NOT",""))'="" D Q:$G(PRCPFLAG)
. S XP="Do you want to print items which were not ordered",XH="Enter 'YES' to print the items not ordered, 'NO' to skip printing it, '^' to exit."
. W ! S %=$$YN^PRCPUYN(1)
. I %=2 Q
. I %=1 S PRCPNOT=1 Q
. S PRCPFLAG=1
;
I $O(^TMP($J,"PRCPAG","OK",""))="",'$G(PRCPERR),'$G(PRCPNOG),'$G(PRCPNOV),'$G(PRCPNOT) Q
S %ZIS="Q" D ^%ZIS Q:POP I $D(IO("Q")) D D ^%ZISC Q
. S ZTDESC="Auto-Generate "_PRCP("IN"),ZTRTN="DQ^PRCPAGU1"
. S ZTSAVE("PRCP*")="",ZTSAVE("^TMP($J,")="",ZTSAVE("ZTREQ")="@"
. D ^%ZTLOAD K IO("Q"),ZTSK
W !!,"<*> please wait <*>"
DQ ; queue comes here to print reports
K PRCPFLAG
I $O(^TMP($J,"PRCPAG","OK",""))'="" D ORDER^PRCPAGRO I $G(PRCPFLAG) D Q Q
I $G(PRCPERR) D ERROR^PRCPAGRE I $G(PRCPFLAG) D Q Q
I $G(PRCPNOV) D NOVEND^PRCPAGRV I $G(PRCPFLAG) D Q Q
I $G(PRCPNOG) D NOGROUP^PRCPAGRG I $G(PRCPFLAG) D Q Q
I $G(PRCPNOT) D ITEMSNOT^PRCPAGRI
Q D ^%ZISC Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPAGU1 3233 printed Sep 23, 2025@19:48:49 Page 2
PRCPAGU1 ;WISC/RFJ-autogenerate utilities ;01 Dec 92
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
DELTEMP(V1,V2) ; delete temp stock level for invpt v1, item v2
+1 IF '$DATA(^PRCP(445,+V1,1,+V2,0))
QUIT
+2 NEW D0,DA,DIE,DR,X,Y
+3 SET V1=+V1
SET V2=+V2
SET DIE="^PRCP(445,"_V1_",1,"
SET DA(1)=V1
SET DA=V2
SET DR="9.5///@;9.6///@"
DO ^DIE
QUIT
+4 ;
+5 ;
OPTIONAL ; check for vendors with items only at optional reorder point
+1 ; do not order optional reorder point if vendor not ordering
+2 ; using standard reorder point
+3 NEW DESCNSN,GNM,ITEMDA,VDA,VNM
+4 SET VNM=""
FOR
SET VNM=$ORDER(^TMP($JOB,"PRCPAG","OK",VNM))
if VNM=""
QUIT
SET VDA=0
FOR
SET VDA=$ORDER(^TMP($JOB,"PRCPAG","OK",VNM,VDA))
if 'VDA
QUIT
IF '$DATA(^TMP($JOB,"PRCPAG","V+",VDA,"STA"))
Begin DoDot:1
+5 SET GNM=""
FOR
SET GNM=$ORDER(^TMP($JOB,"PRCPAG","OK",VNM,VDA,GNM))
if GNM=""
QUIT
SET DESCNSN=""
FOR
SET DESCNSN=$ORDER(^TMP($JOB,"PRCPAG","OK",VNM,VDA,GNM,DESCNSN))
if DESCNSN=""
QUIT
Begin DoDot:2
+6 SET ITEMDA=0
FOR
SET ITEMDA=$ORDER(^TMP($JOB,"PRCPAG","OK",VNM,VDA,GNM,DESCNSN,ITEMDA))
if 'ITEMDA
QUIT
SET ^TMP($JOB,"PRCPAG","NOT",VNM,VDA,GNM,DESCNSN,ITEMDA)=^TMP($JOB,"PRCPAG","OK",VNM,VDA,GNM,DESCNSN,ITEMDA)
SET TOTITEMS=TOTITEMS-1
End DoDot:2
+7 KILL ^TMP($JOB,"PRCPAG","OK",VNM,VDA)
End DoDot:1
+8 QUIT
+9 ;
+10 ;
REPORTS ; ask to print reports
+1 NEW %,PRCPERR,PRCPFLAG,PRCPNOG,PRCPNOV,PRCPNOT
+2 IF $ORDER(^TMP($JOB,"PRCPAG","ER",""))'=""
Begin DoDot:1
+3 SET XP="Do you want to print errors occurring during auto-generation"
SET XH="Enter 'YES' to print the error report, 'NO' to skip printing it, '^' to exit."
+4 WRITE !
SET %=$$YN^PRCPUYN(1)
+5 IF %=2
QUIT
+6 IF %=1
SET PRCPERR=1
QUIT
+7 SET PRCPFLAG=1
End DoDot:1
if $GET(PRCPFLAG)
QUIT
+8 IF $ORDER(^TMP($JOB,"PRCPAG","NOV",""))'=""
Begin DoDot:1
+9 SET XP="Do you want to print items with vendors not selected"
SET XH="Enter 'YES' to print items with vendors not selected report,"
SET XH(1)=" 'NO' to skip printing it, '^' to exit."
+10 WRITE !
SET %=$$YN^PRCPUYN(1)
+11 IF %=2
QUIT
+12 IF %=1
SET PRCPNOV=1
QUIT
+13 SET PRCPFLAG=1
End DoDot:1
if $GET(PRCPFLAG)
QUIT
+14 IF $ORDER(^TMP($JOB,"PRCPAG","NOG",""))'=""
Begin DoDot:1
+15 SET XP="Do you want to print items with groups not selected"
SET XH="Enter 'YES' to print items with groups not selected report,"
SET XH(1)=" 'NO' to skip printing it, '^' to exit."
+16 WRITE !
SET %=$$YN^PRCPUYN(1)
+17 IF %=2
QUIT
+18 IF %=1
SET PRCPNOG=1
QUIT
+19 SET PRCPFLAG=1
End DoDot:1
if $GET(PRCPFLAG)
QUIT
+20 IF $ORDER(^TMP($JOB,"PRCPAG","NOT",""))'=""
Begin DoDot:1
+21 SET XP="Do you want to print items which were not ordered"
SET XH="Enter 'YES' to print the items not ordered, 'NO' to skip printing it, '^' to exit."
+22 WRITE !
SET %=$$YN^PRCPUYN(1)
+23 IF %=2
QUIT
+24 IF %=1
SET PRCPNOT=1
QUIT
+25 SET PRCPFLAG=1
End DoDot:1
if $GET(PRCPFLAG)
QUIT
+26 ;
+27 IF $ORDER(^TMP($JOB,"PRCPAG","OK",""))=""
IF '$GET(PRCPERR)
IF '$GET(PRCPNOG)
IF '$GET(PRCPNOV)
IF '$GET(PRCPNOT)
QUIT
+28 SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
IF $DATA(IO("Q"))
Begin DoDot:1
+29 SET ZTDESC="Auto-Generate "_PRCP("IN")
SET ZTRTN="DQ^PRCPAGU1"
+30 SET ZTSAVE("PRCP*")=""
SET ZTSAVE("^TMP($J,")=""
SET ZTSAVE("ZTREQ")="@"
+31 DO ^%ZTLOAD
KILL IO("Q"),ZTSK
End DoDot:1
DO ^%ZISC
QUIT
+32 WRITE !!,"<*> please wait <*>"
DQ ; queue comes here to print reports
+1 KILL PRCPFLAG
+2 IF $ORDER(^TMP($JOB,"PRCPAG","OK",""))'=""
DO ORDER^PRCPAGRO
IF $GET(PRCPFLAG)
DO Q
QUIT
+3 IF $GET(PRCPERR)
DO ERROR^PRCPAGRE
IF $GET(PRCPFLAG)
DO Q
QUIT
+4 IF $GET(PRCPNOV)
DO NOVEND^PRCPAGRV
IF $GET(PRCPFLAG)
DO Q
QUIT
+5 IF $GET(PRCPNOG)
DO NOGROUP^PRCPAGRG
IF $GET(PRCPFLAG)
DO Q
QUIT
+6 IF $GET(PRCPNOT)
DO ITEMSNOT^PRCPAGRI
Q DO ^%ZISC
QUIT
