- PRCPRLDO ;WISC/RFJ-list distribution orders ;7/24/00 23:29
- ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- D ^PRCPUSEL Q:'$D(PRCP("I"))
- N %,ORDERDA,PRCPFITM,PRCPFLAG,PRCPFPIC,X
- K X S X(1)="The List Distribution Orders To/From Inventory Point option will display distribution orders which have been entered but not posted to the secondary."
- D DISPLAY^PRCPUX2(40,79,.X)
- I PRCP("DPTYPE")="P" D Q:$G(PRCPFLAG)
- . K X S X(1)="You have the option to release all orders which have been placed to "_PRCP("IN")_", but not released for filling." D DISPLAY^PRCPUX2(2,40,.X)
- . S XP="Do you want to release the orders now",XH="Enter YES to release the orders."
- . S %=$$YN^PRCPUYN(2) I '% S PRCPFLAG=1 Q
- . I %=1 D
- . . K ^TMP($J,"PRCPBAL3")
- . . S ORDERDA=0 F S ORDERDA=$O(^PRCP(445.3,ORDERDA)) Q:'ORDERDA S DATA=$G(^(ORDERDA,0)) I $P(DATA,"^",2)=PRCP("I"),$P(DATA,"^",6)="" S ^TMP($J,"PRCPBAL3",ORDERDA)=""
- . . I '$O(^TMP($J,"PRCPBAL3",0)) W !,"NO ORDERS READY FOR RELEASING." Q
- . . D RELEASE^PRCPBAL3
- . . K ^TMP($J,"PRCPBAL3")
- . ;
- . K X S X(1)="You have the option to print the picking tickets for all orders which have been released for filling to "_PRCP("IN")_". Only the picking tickets which have never been printed (no reprints) will be selected."
- . W ! D DISPLAY^PRCPUX2(2,40,.X)
- . S XP="Do you want to print picking tickets for released orders",XH="Enter YES to print the picking tickets for all released orders,",XH(1)="Enter NO to skip printing the picking tickets."
- . S %=$$YN^PRCPUYN(2) I '% S PRCPFLAG=1 Q
- . S PRCPFPIC=$S(%=1:1,1:0)
- I $G(PRCPFPIC) D DEVICE Q
- ;
- K X S X(1)="You have the option to print the list of items for each order or to print each order just displaying the status." W ! D DISPLAY^PRCPUX2(2,40,.X)
- S XP="Do you want to breakout a list of items on each order",XH="Enter YES to display a list of all items on the order,",XH(1)="Enter NO to only print the status of each order."
- S %=$$YN^PRCPUYN(2) I '% Q
- S PRCPFITM=$S(%=1:1,1:0)
- DEVICE ;
- W ! S %ZIS="Q" D ^%ZIS Q:POP
- I $G(PRCPFPIC),IO=IO(0) W !,"YOU CANNOT SELECT YOUR CURRENT DEVICE FOR PRINTING PICKING TICKETS." G DEVICE
- I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
- . S ZTDESC="List Distribution Orders",ZTRTN="DQ^PRCPRLDO"
- . S ZTSAVE("PRCP*")="",ZTSAVE("ZTREQ")="@"
- W !!,"<*> please wait <*>"
- DQ ; queue starts here
- I $G(PRCPFPIC) D PICKTICK Q
- ;
- N DATA,ITEMDA,ITEMDATA,NOW,ORDERDA,PAGE,PRCPFLAG,SCREEN,UNITCOST,X,Y
- D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
- S ORDERDA=0 F S ORDERDA=$O(^PRCP(445.3,ORDERDA)) Q:'ORDERDA!($G(PRCPFLAG)) S DATA=$G(^(ORDERDA,0)) I DATA'="" D
- . I $P(DATA,"^",6)="P" Q
- . I PRCP("DPTYPE")="P",$P(DATA,"^",2)'=PRCP("I") Q
- . I PRCP("DPTYPE")="S",$P(DATA,"^",3)'=PRCP("I") Q
- . S Y=$P(DATA,"^",4) D DD^%DT
- . W !,$P(DATA,"^"),?8,$P(Y,"@"),?22,$P($$TYPE^PRCPOPU(ORDERDA),"ORDER"),?32,$$STATUS^PRCPOPU(ORDERDA)
- . I PRCP("DPTYPE")="P" W ?54,$E($$INVNAME^PRCPUX1(+$P(DATA,"^",3)),1,25)
- . I PRCP("DPTYPE")="S" W ?54,$E($$INVNAME^PRCPUX1(+$P(DATA,"^",2)),1,25)
- . I $Y>(IOSL-5) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H
- . I '$G(PRCPFITM) Q
- . S ITEMDA=0 F S ITEMDA=$O(^PRCP(445.3,ORDERDA,1,ITEMDA)) Q:'ITEMDA!($G(PRCPFLAG)) S ITEMDATA=$G(^(ITEMDA,0)) I ITEMDATA'="" D
- . . S UNITCOST=$P($G(^PRCP(445,+$P(DATA,"^",2),1,ITEMDA,0)),"^",22)
- . . W !?10,$E($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,29),?40,ITEMDA,?50,$J(+$P(ITEMDATA,"^",2),15),$J(UNITCOST,15)
- . . I $Y>(IOSL-5) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H
- D END^PRCPUREP
- D ^%ZISC
- Q
- ;
- ;
- H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
- W $C(13),"LIST DISTRIBUTION ORDER REPORT FOR ",PRCP("IN"),?(80-$L(%)),%
- W !,"ORDER#",?8,"DATE",?22,"TYPE",?32,"STATUS",?54,"DELIVER ",$S(PRCP("DPTYPE")="P":"TO",1:"FROM")," INVENTORY POINT"
- I $G(PRCPFITM) W !?10,"ITEM",?40,"MI#",?50,$J("QUANTITY",15),$J("EST. UNIT COST",15)
- S %="",$P(%,"-",81)="" W !,%
- Q
- ;
- ;
- PICKTICK ; print orders which have been released but the picking ticket
- ; has not been printed
- N DATA,ORDERDA,PRCPORD,PRCPPAT,PRCPPRIM,PRCPSECO
- S ORDERDA=0 F S ORDERDA=$O(^PRCP(445.3,ORDERDA)) Q:'ORDERDA S DATA=$G(^(ORDERDA,0)) I DATA'="" D
- . I PRCP("DPTYPE")="P",$P(DATA,"^",2)'=PRCP("I") Q
- . I $P(DATA,"^",7)="Y" Q
- . I $P(DATA,"^",6)'="R" Q
- . D VARIABLE^PRCPOPU
- . D BUILD^PRCPOPT(ORDERDA)
- . D DQ^PRCPOPT1
- D Q^PRCPOPT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPRLDO 4546 printed Feb 18, 2025@23:41:30 Page 2
- PRCPRLDO ;WISC/RFJ-list distribution orders ;7/24/00 23:29
- +1 ;;5.1;IFCAP;;Oct 20, 2000
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 DO ^PRCPUSEL
- if '$DATA(PRCP("I"))
- QUIT
- +4 NEW %,ORDERDA,PRCPFITM,PRCPFLAG,PRCPFPIC,X
- +5 KILL X
- SET X(1)="The List Distribution Orders To/From Inventory Point option will display distribution orders which have been entered but not posted to the secondary."
- +6 DO DISPLAY^PRCPUX2(40,79,.X)
- +7 IF PRCP("DPTYPE")="P"
- Begin DoDot:1
- +8 KILL X
- SET X(1)="You have the option to release all orders which have been placed to "_PRCP("IN")_", but not released for filling."
- DO DISPLAY^PRCPUX2(2,40,.X)
- +9 SET XP="Do you want to release the orders now"
- SET XH="Enter YES to release the orders."
- +10 SET %=$$YN^PRCPUYN(2)
- IF '%
- SET PRCPFLAG=1
- QUIT
- +11 IF %=1
- Begin DoDot:2
- +12 KILL ^TMP($JOB,"PRCPBAL3")
- +13 SET ORDERDA=0
- FOR
- SET ORDERDA=$ORDER(^PRCP(445.3,ORDERDA))
- if 'ORDERDA
- QUIT
- SET DATA=$GET(^(ORDERDA,0))
- IF $PIECE(DATA,"^",2)=PRCP("I")
- IF $PIECE(DATA,"^",6)=""
- SET ^TMP($JOB,"PRCPBAL3",ORDERDA)=""
- +14 IF '$ORDER(^TMP($JOB,"PRCPBAL3",0))
- WRITE !,"NO ORDERS READY FOR RELEASING."
- QUIT
- +15 DO RELEASE^PRCPBAL3
- +16 KILL ^TMP($JOB,"PRCPBAL3")
- End DoDot:2
- +17 ;
- +18 KILL X
- SET X(1)="You have the option to print the picking tickets for all orders which have been released for filling to "_PRCP("IN")_". Only the picking tickets which have never been printed (no reprints) will be selected."
- +19 WRITE !
- DO DISPLAY^PRCPUX2(2,40,.X)
- +20 SET XP="Do you want to print picking tickets for released orders"
- SET XH="Enter YES to print the picking tickets for all released orders,"
- SET XH(1)="Enter NO to skip printing the picking tickets."
- +21 SET %=$$YN^PRCPUYN(2)
- IF '%
- SET PRCPFLAG=1
- QUIT
- +22 SET PRCPFPIC=$SELECT(%=1:1,1:0)
- End DoDot:1
- if $GET(PRCPFLAG)
- QUIT
- +23 IF $GET(PRCPFPIC)
- DO DEVICE
- QUIT
- +24 ;
- +25 KILL X
- SET X(1)="You have the option to print the list of items for each order or to print each order just displaying the status."
- WRITE !
- DO DISPLAY^PRCPUX2(2,40,.X)
- +26 SET XP="Do you want to breakout a list of items on each order"
- SET XH="Enter YES to display a list of all items on the order,"
- SET XH(1)="Enter NO to only print the status of each order."
- +27 SET %=$$YN^PRCPUYN(2)
- IF '%
- QUIT
- +28 SET PRCPFITM=$SELECT(%=1:1,1:0)
- DEVICE ;
- +1 WRITE !
- SET %ZIS="Q"
- DO ^%ZIS
- if POP
- QUIT
- +2 IF $GET(PRCPFPIC)
- IF IO=IO(0)
- WRITE !,"YOU CANNOT SELECT YOUR CURRENT DEVICE FOR PRINTING PICKING TICKETS."
- GOTO DEVICE
- +3 IF $DATA(IO("Q"))
- Begin DoDot:1
- +4 SET ZTDESC="List Distribution Orders"
- SET ZTRTN="DQ^PRCPRLDO"
- +5 SET ZTSAVE("PRCP*")=""
- SET ZTSAVE("ZTREQ")="@"
- End DoDot:1
- DO ^%ZTLOAD
- KILL IO("Q"),ZTSK
- QUIT
- +6 WRITE !!,"<*> please wait <*>"
- DQ ; queue starts here
- +1 IF $GET(PRCPFPIC)
- DO PICKTICK
- QUIT
- +2 ;
- +3 NEW DATA,ITEMDA,ITEMDATA,NOW,ORDERDA,PAGE,PRCPFLAG,SCREEN,UNITCOST,X,Y
- +4 DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- SET NOW=Y
- SET PAGE=1
- SET SCREEN=$$SCRPAUSE^PRCPUREP
- USE IO
- DO H
- +5 SET ORDERDA=0
- FOR
- SET ORDERDA=$ORDER(^PRCP(445.3,ORDERDA))
- if 'ORDERDA!($GET(PRCPFLAG))
- QUIT
- SET DATA=$GET(^(ORDERDA,0))
- IF DATA'=""
- Begin DoDot:1
- +6 IF $PIECE(DATA,"^",6)="P"
- QUIT
- +7 IF PRCP("DPTYPE")="P"
- IF $PIECE(DATA,"^",2)'=PRCP("I")
- QUIT
- +8 IF PRCP("DPTYPE")="S"
- IF $PIECE(DATA,"^",3)'=PRCP("I")
- QUIT
- +9 SET Y=$PIECE(DATA,"^",4)
- DO DD^%DT
- +10 WRITE !,$PIECE(DATA,"^"),?8,$PIECE(Y,"@"),?22,$PIECE($$TYPE^PRCPOPU(ORDERDA),"ORDER"),?32,$$STATUS^PRCPOPU(ORDERDA)
- +11 IF PRCP("DPTYPE")="P"
- WRITE ?54,$EXTRACT($$INVNAME^PRCPUX1(+$PIECE(DATA,"^",3)),1,25)
- +12 IF PRCP("DPTYPE")="S"
- WRITE ?54,$EXTRACT($$INVNAME^PRCPUX1(+$PIECE(DATA,"^",2)),1,25)
- +13 IF $Y>(IOSL-5)
- if SCREEN
- DO P^PRCPUREP
- if $GET(PRCPFLAG)
- QUIT
- DO H
- +14 IF '$GET(PRCPFITM)
- QUIT
- +15 SET ITEMDA=0
- FOR
- SET ITEMDA=$ORDER(^PRCP(445.3,ORDERDA,1,ITEMDA))
- if 'ITEMDA!($GET(PRCPFLAG))
- QUIT
- SET ITEMDATA=$GET(^(ITEMDA,0))
- IF ITEMDATA'=""
- Begin DoDot:2
- +16 SET UNITCOST=$PIECE($GET(^PRCP(445,+$PIECE(DATA,"^",2),1,ITEMDA,0)),"^",22)
- +17 WRITE !?10,$EXTRACT($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,29),?40,ITEMDA,?50,$JUSTIFY(+$PIECE(ITEMDATA,"^",2),15),$JUSTIFY(UNITCOST,15)
- +18 IF $Y>(IOSL-5)
- if SCREEN
- DO P^PRCPUREP
- if $GET(PRCPFLAG)
- QUIT
- DO H
- End DoDot:2
- End DoDot:1
- +19 DO END^PRCPUREP
- +20 DO ^%ZISC
- +21 QUIT
- +22 ;
- +23 ;
- H SET %=NOW_" PAGE "_PAGE
- SET PAGE=PAGE+1
- IF PAGE'=2!(SCREEN)
- WRITE @IOF
- +1 WRITE $CHAR(13),"LIST DISTRIBUTION ORDER REPORT FOR ",PRCP("IN"),?(80-$LENGTH(%)),%
- +2 WRITE !,"ORDER#",?8,"DATE",?22,"TYPE",?32,"STATUS",?54,"DELIVER ",$SELECT(PRCP("DPTYPE")="P":"TO",1:"FROM")," INVENTORY POINT"
- +3 IF $GET(PRCPFITM)
- WRITE !?10,"ITEM",?40,"MI#",?50,$JUSTIFY("QUANTITY",15),$JUSTIFY("EST. UNIT COST",15)
- +4 SET %=""
- SET $PIECE(%,"-",81)=""
- WRITE !,%
- +5 QUIT
- +6 ;
- +7 ;
- PICKTICK ; print orders which have been released but the picking ticket
- +1 ; has not been printed
- +2 NEW DATA,ORDERDA,PRCPORD,PRCPPAT,PRCPPRIM,PRCPSECO
- +3 SET ORDERDA=0
- FOR
- SET ORDERDA=$ORDER(^PRCP(445.3,ORDERDA))
- if 'ORDERDA
- QUIT
- SET DATA=$GET(^(ORDERDA,0))
- IF DATA'=""
- Begin DoDot:1
- +4 IF PRCP("DPTYPE")="P"
- IF $PIECE(DATA,"^",2)'=PRCP("I")
- QUIT
- +5 IF $PIECE(DATA,"^",7)="Y"
- QUIT
- +6 IF $PIECE(DATA,"^",6)'="R"
- QUIT
- +7 DO VARIABLE^PRCPOPU
- +8 DO BUILD^PRCPOPT(ORDERDA)
- +9 DO DQ^PRCPOPT1
- End DoDot:1
- +10 DO Q^PRCPOPT
- +11 QUIT