PRCPBAL2 ;WISC/RFJ-autogenerate orders for secondaries uploaded ;04 Dec 92
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
AUTOGEN ; autogenerate secondaries
K ^TMP($J,"PRCPBALMAG"),^TMP($J,"PRCPBAL3")
S INVPT=0 F S INVPT=$O(^TMP($J,"PRCPBALMU",INVPT)) Q:'INVPT I $P($G(^PRCP(445,INVPT,0)),"^",3)="S",$P($G(^PRCP(445,INVPT,0)),"^",2)="Y" Q
; no sceondaries uploaded
I 'INVPT Q
W !!,"AUTOGENERATING UPLOADED SECONDARIES..."
I '$G(PRCP("I")) N PRCP S PRCP("DPTYPE")="P" K X S X(1)="Select the PRIMARY inventory point which will be used as the distribution point for the secondaries." W ! D DISPLAY^PRCPUX2(1,40,.X),^PRCPUSEL Q:'$G(PRCP("I"))
S INVPT=0 F S INVPT=$O(^TMP($J,"PRCPBALMU",INVPT)) Q:'INVPT I $P($G(^PRCP(445,INVPT,0)),"^",3)="S",$P($G(^PRCP(445,INVPT,0)),"^",2)="Y",$D(^PRCP(445,PRCP("I"),2,INVPT)) S ^TMP($J,"PRCPBALMAG",INVPT)=""
I '$O(^TMP($J,"PRCPBALMAG",0)) Q
K X S X(1)="The following perpetual secondaries have been uploaded and are distribution points for "_$$INVNAME^PRCPUX1(PRCP("I"))_":" W ! D DISPLAY^PRCPUX2(5,75,.X)
S INVPT=0 F S INVPT=$O(^TMP($J,"PRCPBALMAG",INVPT)) Q:'INVPT W !?10,$$INVNAME^PRCPUX1(INVPT)
S XP="Do you want to start autogenerating distribution orders now",XH="Enter YES to start autogenerating orders for the secondaries, NO or ^ to exit."
I $$YN^PRCPUYN(2)'=1 Q
;
N PRCPFBAR,PRCPIO
;
K X S X(1)="The normal reports showing the errors during autogeneration, items with vendors not selected, items not ordered, etc. will not be printed. You have the option to print the report showing the items ordered."
W ! D DISPLAY^PRCPUX2(5,75,.X)
S XP="Do you want to print the report showing the items ordered",XH="Enter YES to print the report showing the items ordered during autogeneration,",XH(1)="NO to skip printing the report, or ^ to exit."
S %=$$YN^PRCPUYN(2) I %<1 Q
I %=1 D Q:'$D(PRCPIO)
. K X S X(1)="Select the DEVICE for printing the ordered items. This report will be automatically queued to print for you." W ! D DISPLAY^PRCPUX2(5,75,.X)
. F S %ZIS="NQ" D ^%ZIS Q:POP!(IO'=IO(0)) W !,"YOU CANNOT SELECT YOUR CURRENT DEVICE."
. I POP Q
. S PRCPIO=ION
;
S INVPT=0 F S INVPT=$O(^TMP($J,"PRCPBALMAG",INVPT)) Q:'INVPT D
. ; set prcpfbar flag to the primary to fill the order. This
. ; flag will be used to stop the printing of all autogeneration
. ; reports
. S PRCPFBAR=PRCP("I")
. N PRCP
. D PARAM^PRCPUSEL(INVPT)
. W !!,"**** AUTOGENERATING FROM INVENTORY POINT: ",PRCP("IN")," ****"
. K ^TMP($J,"PRCPAG")
. ; selected vendor
. S ^TMP($J,"PRCPAG","V",PRCPFBAR)=""
. D START^PRCPAGS1
. I $D(PRCPIO),$O(^TMP($J,"PRCPAG","OK",""))'="" D
. . W !,"<<< Printing Items Ordered Report"
. . S ZTDESC="Bar Code Upload Autogenerate",ZTRTN="ORDER^PRCPAGRO",ZTIO=PRCPIO,ZTDTH=$H,ZTSAVE("PRCP*")="",ZTSAVE("^TMP($J,")="",ZTSAVE("ZTREQ")="@"
. . D ^%ZTLOAD K ZTSK
. K ^TMP($J,"PRCPAG")
;
; if orders in ^tmp($j,"prcpbal3",orderda), ask to release
I '$O(^TMP($J,"PRCPBAL3",0)) Q
K X S X(1)=" F I N I S H E D A U T O G E N E R A T I O N " W ! D DISPLAY^PRCPUX2(1,79,.X)
; show orders created
K X S X(1)="The following is the list of the orders created showing the order number and secondary inventory point generating the order." W ! D DISPLAY^PRCPUX2(5,75,.X)
S %=0 F S %=$O(^TMP($J,"PRCPBAL3",%)) Q:'% S X=$G(^PRCP(445.3,%,0)) I X'="" W !?5,"order number ",$J($P(X,"^"),5)," from secondary ",$$INVNAME^PRCPUX1($P(X,"^",3))
K X S X(1)="You have the option to release all the orders which were just created by this barcode upload." W !! D DISPLAY^PRCPUX2(2,40,.X)
S XP="Do you want to release all the orders created during the barcode upload",XH="Enter YES to release all the orders created, NO or ^ to exit."
I $$YN^PRCPUYN(1)'=1 Q
D RELEASE^PRCPBAL3
;
; if orders in ^tmp($j,"prcpbal3",orderda), ask to print pick tickets
I '$O(^TMP($J,"PRCPBAL3",0)) Q
K X S X(1)="You have the option to print the picking tickets for all the orders just released." W !! D DISPLAY^PRCPUX2(2,40,.X)
S XP="Do you want to print the picking ticket for the orders just released",XH="Enter YES to print the picking ticket for the orders just released, NO or ^ to exit."
I $$YN^PRCPUYN(1)'=1 Q
D PICKTICK^PRCPBAL3
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPBAL2 4396 printed Oct 16, 2024@18:13:44 Page 2
PRCPBAL2 ;WISC/RFJ-autogenerate orders for secondaries uploaded ;04 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 ;
AUTOGEN ; autogenerate secondaries
+1 KILL ^TMP($JOB,"PRCPBALMAG"),^TMP($JOB,"PRCPBAL3")
+2 SET INVPT=0
FOR
SET INVPT=$ORDER(^TMP($JOB,"PRCPBALMU",INVPT))
if 'INVPT
QUIT
IF $PIECE($GET(^PRCP(445,INVPT,0)),"^",3)="S"
IF $PIECE($GET(^PRCP(445,INVPT,0)),"^",2)="Y"
QUIT
+3 ; no sceondaries uploaded
+4 IF 'INVPT
QUIT
+5 WRITE !!,"AUTOGENERATING UPLOADED SECONDARIES..."
+6 IF '$GET(PRCP("I"))
NEW PRCP
SET PRCP("DPTYPE")="P"
KILL X
SET X(1)="Select the PRIMARY inventory point which will be used as the distribution point for the secondaries."
WRITE !
DO DISPLAY^PRCPUX2(1,40,.X)
DO ^PRCPUSEL
if '$GET(PRCP("I"))
QUIT
+7 SET INVPT=0
FOR
SET INVPT=$ORDER(^TMP($JOB,"PRCPBALMU",INVPT))
if 'INVPT
QUIT
IF $PIECE($GET(^PRCP(445,INVPT,0)),"^",3)="S"
IF $PIECE($GET(^PRCP(445,INVPT,0)),"^",2)="Y"
IF $DATA(^PRCP(445,PRCP("I"),2,INVPT))
SET ^TMP($JOB,"PRCPBALMAG",INVPT)=""
+8 IF '$ORDER(^TMP($JOB,"PRCPBALMAG",0))
QUIT
+9 KILL X
SET X(1)="The following perpetual secondaries have been uploaded and are distribution points for "_$$INVNAME^PRCPUX1(PRCP("I"))_":"
WRITE !
DO DISPLAY^PRCPUX2(5,75,.X)
+10 SET INVPT=0
FOR
SET INVPT=$ORDER(^TMP($JOB,"PRCPBALMAG",INVPT))
if 'INVPT
QUIT
WRITE !?10,$$INVNAME^PRCPUX1(INVPT)
+11 SET XP="Do you want to start autogenerating distribution orders now"
SET XH="Enter YES to start autogenerating orders for the secondaries, NO or ^ to exit."
+12 IF $$YN^PRCPUYN(2)'=1
QUIT
+13 ;
+14 NEW PRCPFBAR,PRCPIO
+15 ;
+16 KILL X
SET X(1)="The normal reports showing the errors during autogeneration, items with vendors not selected, items not ordered, etc. will not be printed. You have the option to print the report showing the items ordered."
+17 WRITE !
DO DISPLAY^PRCPUX2(5,75,.X)
+18 SET XP="Do you want to print the report showing the items ordered"
SET XH="Enter YES to print the report showing the items ordered during autogeneration,"
SET XH(1)="NO to skip printing the report, or ^ to exit."
+19 SET %=$$YN^PRCPUYN(2)
IF %<1
QUIT
+20 IF %=1
Begin DoDot:1
+21 KILL X
SET X(1)="Select the DEVICE for printing the ordered items. This report will be automatically queued to print for you."
WRITE !
DO DISPLAY^PRCPUX2(5,75,.X)
+22 FOR
SET %ZIS="NQ"
DO ^%ZIS
if POP!(IO'=IO(0))
QUIT
WRITE !,"YOU CANNOT SELECT YOUR CURRENT DEVICE."
+23 IF POP
QUIT
+24 SET PRCPIO=ION
End DoDot:1
if '$DATA(PRCPIO)
QUIT
+25 ;
+26 SET INVPT=0
FOR
SET INVPT=$ORDER(^TMP($JOB,"PRCPBALMAG",INVPT))
if 'INVPT
QUIT
Begin DoDot:1
+27 ; set prcpfbar flag to the primary to fill the order. This
+28 ; flag will be used to stop the printing of all autogeneration
+29 ; reports
+30 SET PRCPFBAR=PRCP("I")
+31 NEW PRCP
+32 DO PARAM^PRCPUSEL(INVPT)
+33 WRITE !!,"**** AUTOGENERATING FROM INVENTORY POINT: ",PRCP("IN")," ****"
+34 KILL ^TMP($JOB,"PRCPAG")
+35 ; selected vendor
+36 SET ^TMP($JOB,"PRCPAG","V",PRCPFBAR)=""
+37 DO START^PRCPAGS1
+38 IF $DATA(PRCPIO)
IF $ORDER(^TMP($JOB,"PRCPAG","OK",""))'=""
Begin DoDot:2
+39 WRITE !,"<<< Printing Items Ordered Report"
+40 SET ZTDESC="Bar Code Upload Autogenerate"
SET ZTRTN="ORDER^PRCPAGRO"
SET ZTIO=PRCPIO
SET ZTDTH=$HOROLOG
SET ZTSAVE("PRCP*")=""
SET ZTSAVE("^TMP($J,")=""
SET ZTSAVE("ZTREQ")="@"
+41 DO ^%ZTLOAD
KILL ZTSK
End DoDot:2
+42 KILL ^TMP($JOB,"PRCPAG")
End DoDot:1
+43 ;
+44 ; if orders in ^tmp($j,"prcpbal3",orderda), ask to release
+45 IF '$ORDER(^TMP($JOB,"PRCPBAL3",0))
QUIT
+46 KILL X
SET X(1)=" F I N I S H E D A U T O G E N E R A T I O N "
WRITE !
DO DISPLAY^PRCPUX2(1,79,.X)
+47 ; show orders created
+48 KILL X
SET X(1)="The following is the list of the orders created showing the order number and secondary inventory point generating the order."
WRITE !
DO DISPLAY^PRCPUX2(5,75,.X)
+49 SET %=0
FOR
SET %=$ORDER(^TMP($JOB,"PRCPBAL3",%))
if '%
QUIT
SET X=$GET(^PRCP(445.3,%,0))
IF X'=""
WRITE !?5,"order number ",$JUSTIFY($PIECE(X,"^"),5)," from secondary ",$$INVNAME^PRCPUX1($PIECE(X,"^",3))
+50 KILL X
SET X(1)="You have the option to release all the orders which were just created by this barcode upload."
WRITE !!
DO DISPLAY^PRCPUX2(2,40,.X)
+51 SET XP="Do you want to release all the orders created during the barcode upload"
SET XH="Enter YES to release all the orders created, NO or ^ to exit."
+52 IF $$YN^PRCPUYN(1)'=1
QUIT
+53 DO RELEASE^PRCPBAL3
+54 ;
+55 ; if orders in ^tmp($j,"prcpbal3",orderda), ask to print pick tickets
+56 IF '$ORDER(^TMP($JOB,"PRCPBAL3",0))
QUIT
+57 KILL X
SET X(1)="You have the option to print the picking tickets for all the orders just released."
WRITE !!
DO DISPLAY^PRCPUX2(2,40,.X)
+58 SET XP="Do you want to print the picking ticket for the orders just released"
SET XH="Enter YES to print the picking ticket for the orders just released, NO or ^ to exit."
+59 IF $$YN^PRCPUYN(1)'=1
QUIT
+60 DO PICKTICK^PRCPBAL3
+61 QUIT
