- PSGWAIO ;BHAM ISC/PTD,CML-AOU Inventory Outline for Selected Date Range ; 11 Aug 93 / 7:54 AM
- ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
- BDT S %DT="AEX",%DT("A")="BEGINNING date for report: " D ^%DT K %DT G:Y<0 END S BDT=Y
- EDT S %DT="AEX",%DT(0)=BDT,%DT("A")="ENDING date for report: " D ^%DT K %DT G:Y<0 END S EDT=Y
- W !!,"The right margin for this report is 80.",!,"You may queue the report to print at a later time.",!!
- DEV K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED!" G END
- I $D(IO("Q")) K IO("Q") S ZTRTN="ENQ^PSGWAIO",ZTDESC="Print AOU Inventory Outline" F G="BDT","EDT" S:$D(@G) ZTSAVE(G)=""
- I D ^%ZTLOAD,HOME^%ZIS K ZTSK S QFLG=1 G DONE
- U IO
- ;
- ENQ ;ENTRY POINT WHEN QUEUED
- S INVDT=(BDT-.1) K ^TMP("PSGWIO",$J)
- DTLP S INVDT=$O(^PSI(58.19,"B",INVDT)),INVDA=0 G:($P(INVDT,".")>EDT)!('INVDT) PRINT
- INVLP F J=0:0 S INVDA=$O(^PSI(58.19,"B",INVDT,INVDA)) G:'INVDA DTLP D BUILD
- ;
- PRINT ;PRINT AOU INVENTORY OUTLINE
- S PGCT=1,AOU=0,QFLG="" D HDR I '$O(^TMP("PSGWIO",$J,0)) W !?5,"NO INVENTORIES LISTED FOR SELECTED DATES." G DONE
- AOU F J=0:0 S AOU=$O(^TMP("PSGWIO",$J,AOU)),INVDT=0 G:'AOU!(QFLG) DONE D:$Y+5>IOSL PRTCHK G:QFLG DONE W !!,"==> "_$P(^PSI(58.1,AOU,0),"^") F K=0:0 S INVDT=$O(^TMP("PSGWIO",$J,AOU,INVDT)),WD=0 Q:'INVDT D WKDT Q:QFLG
- ;
- WKDT D:$Y+5>IOSL PRTCHK Q:QFLG S Y=INVDT X ^DD("DD") W !?5,Y
- F L=0:0 S WD=$O(^TMP("PSGWIO",$J,AOU,INVDT,WD)),ID=0 Q:WD=""!(QFLG) W ?30,WD F M=0:0 S ID=$O(^TMP("PSGWIO",$J,AOU,INVDT,WD,ID)),IDUZ=0 Q:'ID W ?39,$J(ID,6) D DUZ Q:QFLG
- Q
- ;
- DUZ F N=0:0 S IDUZ=$O(^TMP("PSGWIO",$J,AOU,INVDT,WD,ID,IDUZ)),LOC="" Q:'IDUZ!(QFLG) S LOC=^(IDUZ),PCL=($L(LOC,",")-1) W ?51,$P(^VA(200,IDUZ,0),"^") F P=2:1:PCL D:$Y+5>IOSL PRTCHK Q:QFLG D WRTYPE
- Q
- ;
- DONE I $E(IOST)'="C" W @IOF
- I $E(IOST)="C" D:'QFLG SS^PSGWUTL1
- END K ZTSK,ANS,QFLG,AOU,BDT,EDT,ID,IDUZ,INVDA,INVDT,INVDUZ,J,K,L,LOC,M,N,P,PCL,PGCT,TYP,TYPSTR,WD,WKD,%,%I,%H,G,Y,^TMP("PSGWIO",$J),IO("Q") D ^%ZISC
- S:$D(ZTQUEUED) ZTREQ="@" Q
- ;
- HDR ;PRINT REPORT MAIN HEADER
- W:$Y @IOF W !,"PHARMACY AREA OF USE INVENTORY LIST FROM " S Y=BDT X ^DD("DD") W Y," TO " S Y=EDT X ^DD("DD") W Y,!,"PRINT DATE: ",$$PSGWDT^PSGWUTL1
- W ?70,"PAGE ",PGCT S PGCT=PGCT+1 W !!,"==> AREA OF USE",!?5,"INVENTORY DATE/TIME",?27,"DAY/WEEK",?39,"INV. ID#",?51,"RESPONSIBLE PERSON",!?22,"TYPES INVENTORIED",! F J=1:1:80 W "-"
- Q
- ;
- BUILD ;STORE INVENTORY DATA FOR DATE RANGE
- S WKD=$S(($P(^PSI(58.19,INVDA,0),"^",2)'=""):$P(^(0),"^",2),1:" "),INVDUZ=$S(($P(^(0),"^",3)'=""):$P(^(0),"^",3),1:" "),AOU=0
- AOULP S AOU=$O(^PSI(58.19,INVDA,1,AOU)),TYP=0,TYPSTR="" Q:'AOU
- TYPLP S TYP=$O(^PSI(58.19,INVDA,1,AOU,1,TYP)),TYPSTR=TYPSTR_","_TYP D:'TYP SETGL G:'TYP AOULP G TYPLP
- ;
- SETGL S ^TMP("PSGWIO",$J,AOU,INVDT,WKD,INVDA,INVDUZ)=TYPSTR
- Q
- ;
- WRTYPE W !?22,$S($D(^PSI(58.16,($P(LOC,",",P)),0)):$P(^(0),"^"),1:"TYPE NAME HAS BEEN DELETED IN FILE 58.16")
- Q
- PRTCHK ;
- I $E(IOST)="C" W !!,"Press <RETURN> to Continue or ""^"" to Exit: " R ANS:DTIME S:'$T ANS="^" D:ANS["?" HELP^PSGWUTL1 I ANS="^" S QFLG=1 Q
- D HDR Q
- PSGWAIO ;BHAM ISC/PTD,CML-AOU Inventory Outline for Selected Date Range ; 11 Aug 93 / 7:54 AM
- +1 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
- BDT SET %DT="AEX"
- SET %DT("A")="BEGINNING date for report: "
- DO ^%DT
- KILL %DT
- IF Y<0
- GOTO END
- SET BDT=Y
- EDT SET %DT="AEX"
- SET %DT(0)=BDT
- SET %DT("A")="ENDING date for report: "
- DO ^%DT
- KILL %DT
- IF Y<0
- GOTO END
- SET EDT=Y
- +1 WRITE !!,"The right margin for this report is 80.",!,"You may queue the report to print at a later time.",!!
- DEV KILL %ZIS,IOP
- SET %ZIS="QM"
- SET %ZIS("B")=""
- DO ^%ZIS
- IF POP
- WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!"
- GOTO END
- +1 IF $DATA(IO("Q"))
- KILL IO("Q")
- SET ZTRTN="ENQ^PSGWAIO"
- SET ZTDESC="Print AOU Inventory Outline"
- FOR G="BDT","EDT"
- IF $DATA(@G)
- SET ZTSAVE(G)=""
- +2 IF $TEST
- DO ^%ZTLOAD
- DO HOME^%ZIS
- KILL ZTSK
- SET QFLG=1
- GOTO DONE
- +3 USE IO
- +4 ;
- ENQ ;ENTRY POINT WHEN QUEUED
- +1 SET INVDT=(BDT-.1)
- KILL ^TMP("PSGWIO",$JOB)
- DTLP SET INVDT=$ORDER(^PSI(58.19,"B",INVDT))
- SET INVDA=0
- IF ($PIECE(INVDT,".")>EDT)!('INVDT)
- GOTO PRINT
- INVLP FOR J=0:0
- SET INVDA=$ORDER(^PSI(58.19,"B",INVDT,INVDA))
- IF 'INVDA
- GOTO DTLP
- DO BUILD
- +1 ;
- PRINT ;PRINT AOU INVENTORY OUTLINE
- +1 SET PGCT=1
- SET AOU=0
- SET QFLG=""
- DO HDR
- IF '$ORDER(^TMP("PSGWIO",$JOB,0))
- WRITE !?5,"NO INVENTORIES LISTED FOR SELECTED DATES."
- GOTO DONE
- AOU FOR J=0:0
- SET AOU=$ORDER(^TMP("PSGWIO",$JOB,AOU))
- SET INVDT=0
- IF 'AOU!(QFLG)
- GOTO DONE
- IF $Y+5>IOSL
- DO PRTCHK
- IF QFLG
- GOTO DONE
- WRITE !!,"==> "_$PIECE(^PSI(58.1,AOU,0),"^")
- FOR K=0:0
- SET INVDT=$ORDER(^TMP("PSGWIO",$JOB,AOU,INVDT))
- SET WD=0
- IF 'INVDT
- QUIT
- DO WKDT
- IF QFLG
- QUIT
- +1 ;
- WKDT IF $Y+5>IOSL
- DO PRTCHK
- IF QFLG
- QUIT
- SET Y=INVDT
- XECUTE ^DD("DD")
- WRITE !?5,Y
- +1 FOR L=0:0
- SET WD=$ORDER(^TMP("PSGWIO",$JOB,AOU,INVDT,WD))
- SET ID=0
- IF WD=""!(QFLG)
- QUIT
- WRITE ?30,WD
- FOR M=0:0
- SET ID=$ORDER(^TMP("PSGWIO",$JOB,AOU,INVDT,WD,ID))
- SET IDUZ=0
- IF 'ID
- QUIT
- WRITE ?39,$JUSTIFY(ID,6)
- DO DUZ
- IF QFLG
- QUIT
- +2 QUIT
- +3 ;
- DUZ FOR N=0:0
- SET IDUZ=$ORDER(^TMP("PSGWIO",$JOB,AOU,INVDT,WD,ID,IDUZ))
- SET LOC=""
- IF 'IDUZ!(QFLG)
- QUIT
- SET LOC=^(IDUZ)
- SET PCL=($LENGTH(LOC,",")-1)
- WRITE ?51,$PIECE(^VA(200,IDUZ,0),"^")
- FOR P=2:1:PCL
- IF $Y+5>IOSL
- DO PRTCHK
- IF QFLG
- QUIT
- DO WRTYPE
- +1 QUIT
- +2 ;
- DONE IF $EXTRACT(IOST)'="C"
- WRITE @IOF
- +1 IF $EXTRACT(IOST)="C"
- IF 'QFLG
- DO SS^PSGWUTL1
- END KILL ZTSK,ANS,QFLG,AOU,BDT,EDT,ID,IDUZ,INVDA,INVDT,INVDUZ,J,K,L,LOC,M,N,P,PCL,PGCT,TYP,TYPSTR,WD,WKD,%,%I,%H,G,Y,^TMP("PSGWIO",$JOB),IO("Q")
- DO ^%ZISC
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- +2 ;
- HDR ;PRINT REPORT MAIN HEADER
- +1 IF $Y
- WRITE @IOF
- WRITE !,"PHARMACY AREA OF USE INVENTORY LIST FROM "
- SET Y=BDT
- XECUTE ^DD("DD")
- WRITE Y," TO "
- SET Y=EDT
- XECUTE ^DD("DD")
- WRITE Y,!,"PRINT DATE: ",$$PSGWDT^PSGWUTL1
- +2 WRITE ?70,"PAGE ",PGCT
- SET PGCT=PGCT+1
- WRITE !!,"==> AREA OF USE",!?5,"INVENTORY DATE/TIME",?27,"DAY/WEEK",?39,"INV. ID#",?51,"RESPONSIBLE PERSON",!?22,"TYPES INVENTORIED",!
- FOR J=1:1:80
- WRITE "-"
- +3 QUIT
- +4 ;
- BUILD ;STORE INVENTORY DATA FOR DATE RANGE
- +1 SET WKD=$SELECT(($PIECE(^PSI(58.19,INVDA,0),"^",2)'=""):$PIECE(^(0),"^",2),1:" ")
- SET INVDUZ=$SELECT(($PIECE(^(0),"^",3)'=""):$PIECE(^(0),"^",3),1:" ")
- SET AOU=0
- AOULP SET AOU=$ORDER(^PSI(58.19,INVDA,1,AOU))
- SET TYP=0
- SET TYPSTR=""
- IF 'AOU
- QUIT
- TYPLP SET TYP=$ORDER(^PSI(58.19,INVDA,1,AOU,1,TYP))
- SET TYPSTR=TYPSTR_","_TYP
- IF 'TYP
- DO SETGL
- IF 'TYP
- GOTO AOULP
- GOTO TYPLP
- +1 ;
- SETGL SET ^TMP("PSGWIO",$JOB,AOU,INVDT,WKD,INVDA,INVDUZ)=TYPSTR
- +1 QUIT
- +2 ;
- WRTYPE WRITE !?22,$SELECT($DATA(^PSI(58.16,($PIECE(LOC,",",P)),0)):$PIECE(^(0),"^"),1:"TYPE NAME HAS BEEN DELETED IN FILE 58.16")
- +1 QUIT
- PRTCHK ;
- +1 IF $EXTRACT(IOST)="C"
- WRITE !!,"Press <RETURN> to Continue or ""^"" to Exit: "
- READ ANS:DTIME
- IF '$TEST
- SET ANS="^"
- IF ANS["?"
- DO HELP^PSGWUTL1
- IF ANS="^"
- SET QFLG=1
- QUIT
- +2 DO HDR
- QUIT
