50 lines
3.0 KiB
Mathematica
50 lines
3.0 KiB
Mathematica
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
|