| [613] | 1 | PSGWAIO ;BHAM ISC/PTD,CML-AOU Inventory Outline for Selected Date Range ; 11 Aug 93 / 7:54 AM
|
|---|
| 2 | ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
|
|---|
| 3 | BDT S %DT="AEX",%DT("A")="BEGINNING date for report: " D ^%DT K %DT G:Y<0 END S BDT=Y
|
|---|
| 4 | EDT S %DT="AEX",%DT(0)=BDT,%DT("A")="ENDING date for report: " D ^%DT K %DT G:Y<0 END S EDT=Y
|
|---|
| 5 | W !!,"The right margin for this report is 80.",!,"You may queue the report to print at a later time.",!!
|
|---|
| 6 | DEV K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED!" G END
|
|---|
| 7 | 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)=""
|
|---|
| 8 | I D ^%ZTLOAD,HOME^%ZIS K ZTSK S QFLG=1 G DONE
|
|---|
| 9 | U IO
|
|---|
| 10 | ;
|
|---|
| 11 | ENQ ;ENTRY POINT WHEN QUEUED
|
|---|
| 12 | S INVDT=(BDT-.1) K ^TMP("PSGWIO",$J)
|
|---|
| 13 | DTLP S INVDT=$O(^PSI(58.19,"B",INVDT)),INVDA=0 G:($P(INVDT,".")>EDT)!('INVDT) PRINT
|
|---|
| 14 | INVLP F J=0:0 S INVDA=$O(^PSI(58.19,"B",INVDT,INVDA)) G:'INVDA DTLP D BUILD
|
|---|
| 15 | ;
|
|---|
| 16 | PRINT ;PRINT AOU INVENTORY OUTLINE
|
|---|
| 17 | S PGCT=1,AOU=0,QFLG="" D HDR I '$O(^TMP("PSGWIO",$J,0)) W !?5,"NO INVENTORIES LISTED FOR SELECTED DATES." G DONE
|
|---|
| 18 | 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
|
|---|
| 19 | ;
|
|---|
| 20 | WKDT D:$Y+5>IOSL PRTCHK Q:QFLG S Y=INVDT X ^DD("DD") W !?5,Y
|
|---|
| 21 | 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
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | 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
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | DONE I $E(IOST)'="C" W @IOF
|
|---|
| 28 | I $E(IOST)="C" D:'QFLG SS^PSGWUTL1
|
|---|
| 29 | 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
|
|---|
| 30 | S:$D(ZTQUEUED) ZTREQ="@" Q
|
|---|
| 31 | ;
|
|---|
| 32 | HDR ;PRINT REPORT MAIN HEADER
|
|---|
| 33 | 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
|
|---|
| 34 | 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 "-"
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | BUILD ;STORE INVENTORY DATA FOR DATE RANGE
|
|---|
| 38 | 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
|
|---|
| 39 | AOULP S AOU=$O(^PSI(58.19,INVDA,1,AOU)),TYP=0,TYPSTR="" Q:'AOU
|
|---|
| 40 | TYPLP S TYP=$O(^PSI(58.19,INVDA,1,AOU,1,TYP)),TYPSTR=TYPSTR_","_TYP D:'TYP SETGL G:'TYP AOULP G TYPLP
|
|---|
| 41 | ;
|
|---|
| 42 | SETGL S ^TMP("PSGWIO",$J,AOU,INVDT,WKD,INVDA,INVDUZ)=TYPSTR
|
|---|
| 43 | Q
|
|---|
| 44 | ;
|
|---|
| 45 | WRTYPE W !?22,$S($D(^PSI(58.16,($P(LOC,",",P)),0)):$P(^(0),"^"),1:"TYPE NAME HAS BEEN DELETED IN FILE 58.16")
|
|---|
| 46 | Q
|
|---|
| 47 | PRTCHK ;
|
|---|
| 48 | 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
|
|---|
| 49 | D HDR Q
|
|---|
