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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGWAIO 3093 printed Oct 16, 2024@17:39:36 Page 2
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
