- PSGWVW ;BHAM ISC/PTD,CML-Lookup Item and List Wards/AOUs Which Stock It ; 29 Dec 93 / 2:31 PM
- ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
- W !!,"Using this option, you may look up the wards and/or Areas of Use",!,"which stock the item you select.",!!,"The right margin for this report is 80.",!,"You may queue the report to print at a later time.",!!
- DIC S DIC="^PSDRUG(",DIC(0)="QEAOM",DIC("A")="Select ITEM Name: " D ^DIC K DIC G:Y<0 END S DRGNUM=+Y
- K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED." G END
- DEV I $D(IO("Q")) K IO("Q") S ZTRTN="ENQ^PSGWVW",ZTDESC="Print Ward/AOU List for Item" S ZTSAVE("DRGNUM")=""
- I D ^%ZTLOAD,HOME^%ZIS K ZTSK G END
- U IO
- ENQ ;ENTRY POINT WHEN QUEUED
- S AOU=0 K ^TMP("PSGWITEM",$J) S $P(LN,"-",80)=""
- AOULP S AOU=$O(^PSI(58.1,AOU)) G:'AOU PRINT S AOUN=$P(^PSI(58.1,AOU,0),"^") I $D(^PSI(58.1,AOU,"I")),^("I")]"",^("I")'>DT S AOUN=AOUN_"^"_"I"
- DRGLP I $D(^PSI(58.1,AOU,1,"B",DRGNUM)) D CHKDRG
- G AOULP
- ;
- CHKDRG S DRGDA=0,DRGDA=$O(^PSI(58.1,AOU,1,"B",DRGNUM,DRGDA))
- I $P(^PSI(58.1,AOU,1,DRGDA,0),"^",10)="Y",$P(^(0),"^",3)="" S $P(^(0),"^",10)=""
- Q:$P(^PSI(58.1,AOU,1,DRGDA,0),"^",3)'=""
- S LOCN=$S($P(^PSI(58.1,AOU,1,DRGDA,0),"^",8)'="":$P(^(0),"^",8),1:"NOT LISTED") S STLEV=$S($P(^PSI(58.1,AOU,1,DRGDA,0),"^",2)'="":$P(^(0),"^",2),1:"NOT LISTED")
- I '$O(^PSI(58.1,AOU,1,DRGDA,4,0)) S WARD=" ",^TMP("PSGWITEM",$J,DRGNUM,WARD,AOUN,LOCN,STLEV)="" Q
- S WRD=0 F J=0:0 S WRD=$O(^PSI(58.1,AOU,1,DRGDA,4,WRD)) Q:'WRD S WARD=$S($D(^DIC(42,WRD,0)):$P(^(0),"^"),1:"NOT FOUND") S ^TMP("PSGWITEM",$J,DRGNUM,WARD,AOUN,LOCN,STLEV)=""
- Q
- ;
- PRINT ;
- S DRG=0,QFLG="" D HDR1 I '$O(^TMP("PSGWITEM",$J,0)) W !!,$P(^PSDRUG(DRGNUM,0),"^")," is not a Ward Stock/Auto Replenishment item." G DONE
- LOOP S DRG=$O(^TMP("PSGWITEM",$J,DRG)) G:'DRG MSG G:QFLG END S DRGNAM=$P(^PSDRUG(DRG,0),"^"),WARD="" D HDR2
- WD S WARD=$O(^TMP("PSGWITEM",$J,DRG,WARD)),AOUN="" G:WARD="" LOOP I $Y+5>IOSL D PRTCHK G:QFLG END W !
- W WARD
- AOU S AOUN=$O(^TMP("PSGWITEM",$J,DRG,WARD,AOUN)),LOCN="" G:AOUN="" WD W ?28,$P(AOUN,"^") I $P(AOUN,"^",2)="I" S INACT=1 W " *"
- LOC S LOCN=$O(^TMP("PSGWITEM",$J,DRG,WARD,AOUN,LOCN)),STLEV="" G:LOCN="" AOU W ?56,LOCN
- STK S STLEV=$O(^TMP("PSGWITEM",$J,DRG,WARD,AOUN,LOCN,STLEV)) G:STLEV="" LOC W ?70,$S(STLEV'="NOT LISTED":$J(STLEV,4),1:STLEV),!
- G STK
- ;
- MSG I INACT W !!!,"* Indicates AOU is currently Inactive"
- DONE I $E(IOST)'="C" W @IOF
- I $E(IOST)="C" D:'QFLG SS^PSGWUTL1
- END K ANS,QFLG,Y,LN,ZTSK,AOU,AOUN,DRG,DRGDA,DRGNAM,DRGNUM,INACT,J,LOCN,WARD,STLEV,WRD,^TMP("PSGWITEM",$J),IO("Q")
- D ^%ZISC
- S:$D(ZTQUEUED) ZTREQ="@" Q
- HDR1 ;
- S INACT=0
- W:$Y @IOF W !,"WARD/AOU LIST FOR AN ITEM",?60,"DATE: " S Y=DT X ^DD("DD") W Y,!,"ITEM NAME",!?70,"STOCK",!?10,"WARD",?35,"AREA OF USE",?56,"LOCATION",?70,"LEVEL",!,LN Q
- HDR2 W !!,"==>",DRGNAM,!! Q
- PRTCHK ;
- I INACT W !!,"* Indicates AOU is currently Inactive"
- I $E(IOST)="C" W !!,"Press <RETURN> to Continue or ""^"" to Exit: " R ANS:DTIME S:'$T ANS="^" D:ANS?1."?" HELP^PSGWUTL1 I ANS="^" S QFLG=1 Q
- D HDR1,HDR2 Q
- PSGWVW ;BHAM ISC/PTD,CML-Lookup Item and List Wards/AOUs Which Stock It ; 29 Dec 93 / 2:31 PM
- +1 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
- +2 WRITE !!,"Using this option, you may look up the wards and/or Areas of Use",!,"which stock the item you select.",!!,"The right margin for this report is 80.",!,"You may queue the report to print at a later time.",!!
- DIC SET DIC="^PSDRUG("
- SET DIC(0)="QEAOM"
- SET DIC("A")="Select ITEM Name: "
- DO ^DIC
- KILL DIC
- IF Y<0
- GOTO END
- SET DRGNUM=+Y
- +1 KILL %ZIS,IOP
- SET %ZIS="QM"
- SET %ZIS("B")=""
- DO ^%ZIS
- IF POP
- WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED."
- GOTO END
- DEV IF $DATA(IO("Q"))
- KILL IO("Q")
- SET ZTRTN="ENQ^PSGWVW"
- SET ZTDESC="Print Ward/AOU List for Item"
- SET ZTSAVE("DRGNUM")=""
- +1 IF $TEST
- DO ^%ZTLOAD
- DO HOME^%ZIS
- KILL ZTSK
- GOTO END
- +2 USE IO
- ENQ ;ENTRY POINT WHEN QUEUED
- +1 SET AOU=0
- KILL ^TMP("PSGWITEM",$JOB)
- SET $PIECE(LN,"-",80)=""
- AOULP SET AOU=$ORDER(^PSI(58.1,AOU))
- IF 'AOU
- GOTO PRINT
- SET AOUN=$PIECE(^PSI(58.1,AOU,0),"^")
- IF $DATA(^PSI(58.1,AOU,"I"))
- IF ^("I")]""
- IF ^("I")'>DT
- SET AOUN=AOUN_"^"_"I"
- DRGLP IF $DATA(^PSI(58.1,AOU,1,"B",DRGNUM))
- DO CHKDRG
- +1 GOTO AOULP
- +2 ;
- CHKDRG SET DRGDA=0
- SET DRGDA=$ORDER(^PSI(58.1,AOU,1,"B",DRGNUM,DRGDA))
- +1 IF $PIECE(^PSI(58.1,AOU,1,DRGDA,0),"^",10)="Y"
- IF $PIECE(^(0),"^",3)=""
- SET $PIECE(^(0),"^",10)=""
- +2 IF $PIECE(^PSI(58.1,AOU,1,DRGDA,0),"^",3)'=""
- QUIT
- +3 SET LOCN=$SELECT($PIECE(^PSI(58.1,AOU,1,DRGDA,0),"^",8)'="":$PIECE(^(0),"^",8),1:"NOT LISTED")
- SET STLEV=$SELECT($PIECE(^PSI(58.1,AOU,1,DRGDA,0),"^",2)'="":$PIECE(^(0),"^",2),1:"NOT LISTED")
- +4 IF '$ORDER(^PSI(58.1,AOU,1,DRGDA,4,0))
- SET WARD=" "
- SET ^TMP("PSGWITEM",$JOB,DRGNUM,WARD,AOUN,LOCN,STLEV)=""
- QUIT
- +5 SET WRD=0
- FOR J=0:0
- SET WRD=$ORDER(^PSI(58.1,AOU,1,DRGDA,4,WRD))
- IF 'WRD
- QUIT
- SET WARD=$SELECT($DATA(^DIC(42,WRD,0)):$PIECE(^(0),"^"),1:"NOT FOUND")
- SET ^TMP("PSGWITEM",$JOB,DRGNUM,WARD,AOUN,LOCN,STLEV)=""
- +6 QUIT
- +7 ;
- PRINT ;
- +1 SET DRG=0
- SET QFLG=""
- DO HDR1
- IF '$ORDER(^TMP("PSGWITEM",$JOB,0))
- WRITE !!,$PIECE(^PSDRUG(DRGNUM,0),"^")," is not a Ward Stock/Auto Replenishment item."
- GOTO DONE
- LOOP SET DRG=$ORDER(^TMP("PSGWITEM",$JOB,DRG))
- IF 'DRG
- GOTO MSG
- IF QFLG
- GOTO END
- SET DRGNAM=$PIECE(^PSDRUG(DRG,0),"^")
- SET WARD=""
- DO HDR2
- WD SET WARD=$ORDER(^TMP("PSGWITEM",$JOB,DRG,WARD))
- SET AOUN=""
- IF WARD=""
- GOTO LOOP
- IF $Y+5>IOSL
- DO PRTCHK
- IF QFLG
- GOTO END
- WRITE !
- +1 WRITE WARD
- AOU SET AOUN=$ORDER(^TMP("PSGWITEM",$JOB,DRG,WARD,AOUN))
- SET LOCN=""
- IF AOUN=""
- GOTO WD
- WRITE ?28,$PIECE(AOUN,"^")
- IF $PIECE(AOUN,"^",2)="I"
- SET INACT=1
- WRITE " *"
- LOC SET LOCN=$ORDER(^TMP("PSGWITEM",$JOB,DRG,WARD,AOUN,LOCN))
- SET STLEV=""
- IF LOCN=""
- GOTO AOU
- WRITE ?56,LOCN
- STK SET STLEV=$ORDER(^TMP("PSGWITEM",$JOB,DRG,WARD,AOUN,LOCN,STLEV))
- IF STLEV=""
- GOTO LOC
- WRITE ?70,$SELECT(STLEV'="NOT LISTED":$JUSTIFY(STLEV,4),1:STLEV),!
- +1 GOTO STK
- +2 ;
- MSG IF INACT
- WRITE !!!,"* Indicates AOU is currently Inactive"
- DONE IF $EXTRACT(IOST)'="C"
- WRITE @IOF
- +1 IF $EXTRACT(IOST)="C"
- IF 'QFLG
- DO SS^PSGWUTL1
- END KILL ANS,QFLG,Y,LN,ZTSK,AOU,AOUN,DRG,DRGDA,DRGNAM,DRGNUM,INACT,J,LOCN,WARD,STLEV,WRD,^TMP("PSGWITEM",$JOB),IO("Q")
- +1 DO ^%ZISC
- +2 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- HDR1 ;
- +1 SET INACT=0
- +2 IF $Y
- WRITE @IOF
- WRITE !,"WARD/AOU LIST FOR AN ITEM",?60,"DATE: "
- SET Y=DT
- XECUTE ^DD("DD")
- WRITE Y,!,"ITEM NAME",!?70,"STOCK",!?10,"WARD",?35,"AREA OF USE",?56,"LOCATION",?70,"LEVEL",!,LN
- QUIT
- HDR2 WRITE !!,"==>",DRGNAM,!!
- QUIT
- PRTCHK ;
- +1 IF INACT
- WRITE !!,"* Indicates AOU is currently Inactive"
- +2 IF $EXTRACT(IOST)="C"
- WRITE !!,"Press <RETURN> to Continue or ""^"" to Exit: "
- READ ANS:DTIME
- IF '$TEST
- SET ANS="^"
- IF ANS?1."?"
- DO HELP^PSGWUTL1
- IF ANS="^"
- SET QFLG=1
- QUIT
- +3 DO HDR1
- DO HDR2
- QUIT
