74 lines
3.8 KiB
Mathematica
74 lines
3.8 KiB
Mathematica
PSGWTOT2 ;BHAM ISC/PTD,CML-Print Usage Report for Single Drug for One or ALL AOUs ; 23 Mar 93 / 1:03 PM
|
|
;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
|
|
ENQ ;ENTRY POINT WHEN QUEUED.
|
|
K ^TMP("PSGWUSE",$J)
|
|
AOULP I AOUFL=1 S AOU=$O(^PSI(58.1,AOU)) G:('AOU)&($D(ZTQUEUED)) PRTQUE G:'AOU PRINT
|
|
S DRGDA=0
|
|
DRG S DRGDA=$O(^PSI(58.1,AOU,1,"B",DRGNM,DRGDA)) G:(AOUFL=0)&('DRGDA)&($D(ZTQUEUED)) PRTQUE G:(AOUFL=0)&('DRGDA) PRINT G:(AOUFL=1)&('DRGDA) AOULP
|
|
;
|
|
AR ;INVENTORIES
|
|
S INVDA=0
|
|
INVLP S INVDA=$O(^PSI(58.1,AOU,1,DRGDA,1,INVDA)) G:'INVDA OD S INVDT=$S($D(^PSI(58.19,INVDA,0)):$P(^(0),"^"),1:"")
|
|
I 'INVDT,'$D(^PSI(58.19,INVDA,0)) S DIE="^PSI(58.1,AOU,1,DRGDA,1,",DA=INVDA,DA(1)=DRGDA,DA(2)=AOU,DR=".01///@" D ^DIE K DIE G INVLP
|
|
I ($P(INVDT,".")'<BDT)&($P(INVDT,".")'>EDT) S:$P(^PSI(58.1,AOU,1,DRGDA,1,INVDA,0),"^",5)'="" ^TMP("PSGWUSE",$J,AOU,"AR",INVDT)=$P(^PSI(58.1,AOU,1,DRGDA,1,INVDA,0),"^",5)
|
|
G INVLP
|
|
;
|
|
OD ;ON DEMANDS
|
|
S ODA=0
|
|
ODLP S ODA=$O(^PSI(58.1,AOU,1,DRGDA,5,ODA)) G:'ODA RET S ODT=$P(^PSI(58.1,AOU,1,DRGDA,5,ODA,0),"^")
|
|
I ($P(ODT,".")'<BDT)&($P(ODT,".")'>EDT) S:$P(^PSI(58.1,AOU,1,DRGDA,5,ODA,0),"^",2)'="" ^TMP("PSGWUSE",$J,AOU,"OD",ODT)=$P(^PSI(58.1,AOU,1,DRGDA,5,ODA,0),"^",2)
|
|
G ODLP
|
|
;
|
|
RET ;RETURNS
|
|
S RETDT=0
|
|
RETLP S RETDT=$O(^PSI(58.1,AOU,1,DRGDA,3,RETDT)) G:'RETDT DRG
|
|
I (RETDT'<BDT)&(RETDT'>EDT) S:$P(^PSI(58.1,AOU,1,DRGDA,3,RETDT,0),"^",2)'="" ^TMP("PSGWUSE",$J,AOU,"RT",RETDT)=$P(^PSI(58.1,AOU,1,DRGDA,3,RETDT,0),"^",2)
|
|
G RETLP
|
|
;
|
|
PRTQUE ;AFTER DATA IS COMPILED, QUEUE THE PRINT
|
|
K ZTSAVE,ZTIO S ZTIO=PSGWIO,ZTRTN="PRINT^PSGWTOT2",ZTDESC="Print Usage Report",ZTDTH=$H,ZTSAVE("^TMP(""PSGWUSE"",$J,")="" F G="BDT","EDT","AOU","AOUFL","ITNAM","ITMFL","DRGNM" S:$D(@G) ZTSAVE(G)=""
|
|
D ^%ZTLOAD G END
|
|
;
|
|
PRINT ;PRINT USAGE REPORT FOR SINGLE DRUG BY AOU
|
|
S (AOU,GRTOT)=0,PGCT=1,QFLG="" I '$O(^TMP("PSGWUSE",$J,AOU)) D HDR W !!?10,"NO USAGE FOR ",ITNAM," FOR SELECTED DATES." G DONE
|
|
D HDR
|
|
AOU S (DRGQD,ARQD,ODQD,RTQD,QD,TYP)=0 S AOU=$O(^TMP("PSGWUSE",$J,AOU)) D:('AOU)&(AOUFL=1) GRTOT G:QFLG END G:'AOU DONE D SUB G:QFLG END
|
|
TYP S TYP=$O(^TMP("PSGWUSE",$J,AOU,TYP)),INVDT=0 D:TYP="" TOTAL G:QFLG END G:TYP="" AOU D:$Y+5>IOSL PRTCHK G:QFLG END W:TYP="AR" !?10,"AUTO REPLENISHMENT" W:TYP="OD" !?10,"ON DEMAND" W:TYP="RT" !?10,"RETURNS"
|
|
DT S INVDT=$O(^TMP("PSGWUSE",$J,AOU,TYP,INVDT)) G:'INVDT SUBTOT S QD=$P(^TMP("PSGWUSE",$J,AOU,TYP,INVDT),"^")
|
|
I TYP="AR" S ARQD=ARQD+QD,DRGQD=DRGQD+QD
|
|
I TYP="OD" S ODQD=ODQD+QD,DRGQD=DRGQD+QD
|
|
I TYP="RT" S RTQD=RTQD+QD,DRGQD=DRGQD-QD
|
|
D:$Y+5>IOSL PRTCHK G:QFLG END D WRTLN G DT
|
|
;
|
|
DONE I $E(IOST)'="C" W @IOF
|
|
I $E(IOST)="C" D:'QFLG SS^PSGWUTL1
|
|
END K ^TMP("PSGWUSE",$J),AOU,AOUFL,ARQD,BDT,DRGDA,ANS,QFLG,DRGNM,DRGQD,EDT,INVDA,INVDT,ITMFL,ITNAM,J,GRTOT,ODA,ODT,ODQD,PGCT,QD,RETDT,RTQD,TYP,PSGWIO,PSGWION,ZTSK,ZTIO,%,%H,%I,DA,G,X,Y,DA,DR
|
|
D ^%ZISC
|
|
S:$D(ZTQUEUED) ZTREQ="@" Q
|
|
;
|
|
HDR ;
|
|
W:$Y @IOF W !,"USAGE REPORT FROM " S Y=BDT X ^DD("DD") W Y," TO " S Y=EDT X ^DD("DD") W Y,?70,"PAGE ",PGCT S PGCT=PGCT+1
|
|
W !?5,"AREA OF USE",?55,"DATE: ",$$PSGWDT^PSGWUTL1,!,"ITEM",?15,"INVENTORY DATE",?35,"DISPENSE QUANTITY",! F J=1:1:80 W "-"
|
|
Q
|
|
SUB ;
|
|
I $Y+5>IOSL D PRTCHK I QFLG Q
|
|
W !!?5,"==> ",$P(^PSI(58.1,AOU,0),"^"),!,ITNAM,!!
|
|
Q
|
|
;
|
|
WRTLN S Y=INVDT X ^DD("DD") W !?15,$P(Y,"@")," ",$P(Y,"@",2),?43,$J(QD,4) Q
|
|
SUBTOT ;
|
|
I $Y+5>IOSL D PRTCHK I QFLG Q
|
|
W !?43,"-----" W:TYP="AR" !?12,"SUBTOTAL AUTO REPL.",?40,"+",?43,$J(ARQD,4),! W:TYP="OD" !?12,"SUBTOTAL ON DEMAND",?40,"+",?43,$J(ODQD,4),! W:TYP="RT" !?12,"SUBTOTAL RETURNS",?40,"-",?43,$J(RTQD,4),!
|
|
G TYP
|
|
;
|
|
TOTAL W !?42,"=======",!,"TOTAL DISPENSED",?43,$J(DRGQD,4) S GRTOT=GRTOT+DRGQD
|
|
Q
|
|
GRTOT ;
|
|
I $Y+5>IOSL D PRTCHK I QFLG Q
|
|
W !!?38 F J=1:1:15 W "="
|
|
W !,"TOTAL USAGE FOR ALL AREAS IS:",?43,$J(GRTOT,4)
|
|
Q
|
|
PRTCHK ;
|
|
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 HDR Q
|