- PSGWPIS ;BHAM ISC/CML-Print AOU Inventory Sheet for a single AOU ; 29 Dec 93 / 9:15 AM
- ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
- I '$D(PSGWSITE) D ^PSGWSET Q:'$D(PSGWSITE) S PSGWFLG=1
- BAR S BARFLG=1 W !!,"This option will print a bar coded Inventory Sheet. In order to do so, you",!,"must queue the output to a printer that is properly set up to produce bar codes."
- EN ; Entry point for no bar codes
- I '$D(PSGWSITE) D ^PSGWSET Q:'$D(PSGWSITE) S PSGWFLG=1
- W !!,"This option will print an Inventory Sheet for a single AOU that is included in",!,"an existing Inventory Date/Time.",!
- ASKINV S DIC="^PSI(58.19,",DLAYGO=58.19,DIC(0)="QEAMLNZ",DIC("A")="SELECT DATE/TIME FOR INVENTORY: " D ^DIC K DIC,DLAYGO G:Y<0 QUIT S PSGWIDA=+Y
- D LIST G:'$D(AOU) ASKINV W ! S DIC="^PSI(58.1,",DIC(0)="QEAM",DIC("S")="I $D(^PSI(58.19,PSGWIDA,1,""B"",+Y,+Y))",DIC("A")="Select AOU: " D ^DIC K DIC G:Y<0 QUIT S AOU=+Y
- W !!,"Right margin for this printout is 132!",!! S PSGWDT=DT
- DEV K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED!" G QUIT
- I $D(BARFLG),'$D(^%ZIS(2,^%ZIS(1,IOS,"SUBTYPE"),"BAR0"))!('$D(^%ZIS(2,^%ZIS(1,IOS,"SUBTYPE"),"BAR1"))) W *7,!!,"THE DEVICE YOU HAVE SELECTED IS NOT SET UP TO PRINT BAR CODES!!",! G DEV
- I $D(IO("Q")) K IO("Q") S ZTRTN="EN1^PSGWPIS",ZTDESC=$S($D(BARFLG):"Print Single Bar Coded Inventory Sheet",1:"Print Single Inventory Sheet") F G="PSGWIDA","PSGWDT","PSGWSITE","BARFLG","AOU","PRTFLG" S:$D(G) ZTSAVE(G)=""
- I D ^%ZTLOAD,HOME^%ZIS K ZTSK G QUIT
- EN1 U IO D EN1^PSGWPI1
- QUIT K PSGW("PO"),PSG1,PSG2,PSG3,PSGDA,PSGDDA,PSGDR,PSGINAD,PSGNT,PSGPAGE,PSGSORTK,STKCHG,PSGTN,PSGTODAY,PSGWIDA,PSGWIN,PSGWN,PSGTYP,PSGWGRP,PSGWLP,PSGWPC,PSGD,PSGISORT,PSGLSORT,PSGSORT,PSGT,PSGW,PSGWDUP,PSGWN,PSGWPGD,PSI,PSGWDT,DIE,DR
- K CHK,GROUP,ZTSK,BARFLG,PSGWBARS,PSGWBAR0,PSGWBAR1,I,LOC,STLEV,DRGDA,J,K,G,K1,EXP,LN,LN1,LN2,LNCNT,TAB1,TAB2,TYPE,Q,LFC,SK,X,Y,MH,NN,AA,D1,DA,PSGSW,SKK,GRP,LP,PC,AOULP,AOU,JJ,AOUCNT,IO("Q") D ^%ZISC
- K:$D(PSGWFLG) PSGWFLG,PSGWSITE
- S:$D(ZTQUEUED) ZTREQ="@" Q
- LIST ; List all the AOUs included in the inventory
- I '$O(^PSI(58.19,PSGWIDA,1,"B",0)) W *7,!,"There are not any AOUs defined for this Inventory!",! Q
- S AOUCNT=0 F AOU=0:0 S AOU=$O(^PSI(58.19,PSGWIDA,1,"B",AOU)) Q:'AOU S AOULP($P(^PSI(58.1,AOU,0),"^"))="",AOUCNT=AOUCNT+1
- W !!,"The following AOU",$S(AOUCNT>1:"s are",1:" is")," included on this Inventory Sheet:" S AOU="" F JJ=0:0 S AOU=$O(AOULP(AOU)) Q:AOU="" W !?5,AOU
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGWPIS 2499 printed Mar 13, 2025@20:44:33 Page 2
- PSGWPIS ;BHAM ISC/CML-Print AOU Inventory Sheet for a single AOU ; 29 Dec 93 / 9:15 AM
- +1 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
- +2 IF '$DATA(PSGWSITE)
- DO ^PSGWSET
- if '$DATA(PSGWSITE)
- QUIT
- SET PSGWFLG=1
- BAR SET BARFLG=1
- WRITE !!,"This option will print a bar coded Inventory Sheet. In order to do so, you",!,"must queue the output to a printer that is properly set up to produce bar codes."
- EN ; Entry point for no bar codes
- +1 IF '$DATA(PSGWSITE)
- DO ^PSGWSET
- if '$DATA(PSGWSITE)
- QUIT
- SET PSGWFLG=1
- +2 WRITE !!,"This option will print an Inventory Sheet for a single AOU that is included in",!,"an existing Inventory Date/Time.",!
- ASKINV SET DIC="^PSI(58.19,"
- SET DLAYGO=58.19
- SET DIC(0)="QEAMLNZ"
- SET DIC("A")="SELECT DATE/TIME FOR INVENTORY: "
- DO ^DIC
- KILL DIC,DLAYGO
- if Y<0
- GOTO QUIT
- SET PSGWIDA=+Y
- +1 DO LIST
- if '$DATA(AOU)
- GOTO ASKINV
- WRITE !
- SET DIC="^PSI(58.1,"
- SET DIC(0)="QEAM"
- SET DIC("S")="I $D(^PSI(58.19,PSGWIDA,1,""B"",+Y,+Y))"
- SET DIC("A")="Select AOU: "
- DO ^DIC
- KILL DIC
- if Y<0
- GOTO QUIT
- SET AOU=+Y
- +2 WRITE !!,"Right margin for this printout is 132!",!!
- SET PSGWDT=DT
- DEV KILL %ZIS,IOP
- SET %ZIS="QM"
- SET %ZIS("B")=""
- DO ^%ZIS
- IF POP
- WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!"
- GOTO QUIT
- +1 IF $DATA(BARFLG)
- IF '$DATA(^%ZIS(2,^%ZIS(1,IOS,"SUBTYPE"),"BAR0"))!('$DATA(^%ZIS(2,^%ZIS(1,IOS,"SUBTYPE"),"BAR1")))
- WRITE *7,!!,"THE DEVICE YOU HAVE SELECTED IS NOT SET UP TO PRINT BAR CODES!!",!
- GOTO DEV
- +2 IF $DATA(IO("Q"))
- KILL IO("Q")
- SET ZTRTN="EN1^PSGWPIS"
- SET ZTDESC=$SELECT($DATA(BARFLG):"Print Single Bar Coded Inventory Sheet",1:"Print Single Inventory Sheet")
- FOR G="PSGWIDA","PSGWDT","PSGWSITE","BARFLG","AOU","PRTFLG"
- if $DATA(G)
- SET ZTSAVE(G)=""
- +3 IF $TEST
- DO ^%ZTLOAD
- DO HOME^%ZIS
- KILL ZTSK
- GOTO QUIT
- EN1 USE IO
- DO EN1^PSGWPI1
- QUIT KILL PSGW("PO"),PSG1,PSG2,PSG3,PSGDA,PSGDDA,PSGDR,PSGINAD,PSGNT,PSGPAGE,PSGSORTK,STKCHG,PSGTN,PSGTODAY,PSGWIDA,PSGWIN,PSGWN,PSGTYP,PSGWGRP,PSGWLP,PSGWPC,PSGD,PSGISORT,PSGLSORT,PSGSORT,PSGT,PSGW,PSGWDUP,PSGWN,PSGWPGD,PSI,PSGWDT,DIE,DR
- +1 KILL CHK,GROUP,ZTSK,BARFLG,PSGWBARS,PSGWBAR0,PSGWBAR1,I,LOC,STLEV,DRGDA,J,K,G,K1,EXP,LN,LN1,LN2,LNCNT,TAB1,TAB2,TYPE,Q,LFC,SK,X,Y,MH,NN,AA,D1,DA,PSGSW,SKK,GRP,LP,PC,AOULP,AOU,JJ,AOUCNT,IO("Q")
- DO ^%ZISC
- +2 if $DATA(PSGWFLG)
- KILL PSGWFLG,PSGWSITE
- +3 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- LIST ; List all the AOUs included in the inventory
- +1 IF '$ORDER(^PSI(58.19,PSGWIDA,1,"B",0))
- WRITE *7,!,"There are not any AOUs defined for this Inventory!",!
- QUIT
- +2 SET AOUCNT=0
- FOR AOU=0:0
- SET AOU=$ORDER(^PSI(58.19,PSGWIDA,1,"B",AOU))
- if 'AOU
- QUIT
- SET AOULP($PIECE(^PSI(58.1,AOU,0),"^"))=""
- SET AOUCNT=AOUCNT+1
- +3 WRITE !!,"The following AOU",$SELECT(AOUCNT>1:"s are",1:" is")," included on this Inventory Sheet:"
- SET AOU=""
- FOR JJ=0:0
- SET AOU=$ORDER(AOULP(AOU))
- if AOU=""
- QUIT
- WRITE !?5,AOU
- +4 QUIT
