36 lines
2.9 KiB
Mathematica
36 lines
2.9 KiB
Mathematica
PSDPDR1 ;BIR/BJW-Narc Disp/Rec Report (VA FORM 10-2321) (cont'd) ; 03 Mar 98
|
|
;;3.0; CONTROLLED SUBSTANCES ;**8**;13 Feb 97
|
|
;**Y2K compliance** display 4 digit year on va forms
|
|
START ;compile data
|
|
K ^TMP("PSDRPT",$J)
|
|
I $D(PSDG) F PSD=0:0 S PSD=$O(PSDG(PSD)) Q:'PSD F PSDN=0:0 S PSDN=$O(^PSI(58.2,PSD,3,PSDN)) Q:'PSDN I $D(^PSD(58.8,PSDN,0)),$P(^(0),"^",2)="N",+$P(^(0),"^",4)=+PSDS S NAOU(PSDN)="",CNT=CNT+1
|
|
I $D(ALL) F PSD=0:0 S PSD=$O(^PSD(58.8,PSD)) Q:'PSD I $D(^PSD(58.8,PSD,0)),$P(^(0),"^",2)="N",$P(^(0),"^",4)=+PSDS S NAOU(+PSD)=""
|
|
F PSD=0:0 S PSD=$O(^PSD(58.81,"AD",3,PSD)) G:('PSD)&($D(ZTQUEUED)) PRTQUE G:'PSD PRINT^PSDPDR2 F PSDA=0:0 S PSDA=$O(^PSD(58.81,"AD",3,PSD,PSDA)) Q:'PSDA I $D(^PSD(58.81,PSDA,0)) D
|
|
.S NODE=^PSD(58.81,PSDA,0),PSDN=+$P(NODE,"^",18)
|
|
.I $D(NAOU(PSDN)) S PSDNA=$S($P($G(^PSD(58.8,PSDN,0)),"^")]"":$P(^(0),"^"),1:"ZZ/"_PSDN) D
|
|
..S PSDR=+$P(NODE,"^",5),PSDRN=$S($P($G(^PSDRUG(PSDR,0)),"^")]"":$P(^(0),"^"),1:"ZZ/"_PSDR),STAT=+$P(NODE,"^",11) Q:+$P($G(^PSD(58.81,PSDA,"CS")),"^",3)!(STAT'=3)
|
|
..S STATN=$S($P($G(^PSD(58.82,STAT,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
|
|
..S QTY=$P(NODE,"^",6) I $D(^PSD(58.81,PSDA,4)),+$P(^(4),"^",3) S QTY=$P(^(4),"^",3)
|
|
..S COMM=$S($D(^PSD(58.81,PSDA,2,0)):1,1:0),MFG=$P(NODE,"^",13),LOT=$P(NODE,"^",14),EXP=$P(NODE,"^",15),EXPD=""
|
|
..;;The next two lines inserted for E3R# 3311 2-9-95.
|
|
..S:$D(^PSD(58.81,PSDA,4)) NEWBAL=$P(^(4),"^",7)+$P(^(4),"^",4),FNOTE="*"
|
|
..S:'$D(^PSD(58.81,PSDA,4)) NEWBAL=$P(NODE,"^",10)-QTY,FNOTE=""
|
|
..I EXP S (EXP1,EXPD)=$$FMTE^XLFDT(EXP,"5D") S:'$P(EXP1,"/",2) EXPD=$P(EXP1,"/")_"/"_$P(EXP1,"/",3) S EXP=EXPD
|
|
..S NUM=$S($P(NODE,"^",17)]"":$P(NODE,"^",17),1:"UNKNOWN")
|
|
..S ORD=+$P($G(^PSD(58.81,PSDA,1)),"^",7),ORDN=$S($P($G(^VA(200,ORD,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
|
|
..S REQD=$P($G(^PSD(58.81,PSDA,1)),"^",6),REQDT="" I REQD S Y=REQD X ^DD("DD") S PSDYR=$P(Y,",",2),PSDYR=$E(PSDYR,1,4) S REQDT=$E(REQD,4,5)_"/"_$E(REQD,6,7)_"/"_PSDYR
|
|
..S PSDST=$P(NODE,"^",4),PSDDT="" I PSDST S Y=PSDST X ^DD("DD") S PSDYR=$P(Y,",",2),PSDYR=$E(PSDYR,1,4)
|
|
..S PSDDT=$E(PSDST,4,5)_"/"_$E(PSDST,6,7)_"/"_PSDYR
|
|
..;;Fnote and Newbal added for E3R# 3311 2-9-95.
|
|
..S ^TMP("PSDRPT",$J,PSDNA,NUM)=PSDRN_"^"_QTY_FNOTE_"^"_PSDDT_"^"_REQDT_"^"_ORDN_"^"_MFG_"^"_LOT_"^"_EXPD_"^"_COMM_"^"_PSDA_"^"_NEWBAL_"^"_FNOTE
|
|
Q
|
|
PRTQUE ;queues print after compile
|
|
K ZTSAVE,ZTIO S ZTIO=PSDIO,ZTRTN="PRINT^PSDPDR2",ZTDESC="Print Narcotic Disp Report",ZTDTH=$H
|
|
S (ZTSAVE("^TMP(""PSDRPT"",$J,"),ZTSAVE("PSDS"),ZTSAVE("PSDPT"),ZTSAVE("CNT"),ZTSAVE("PSDCPY"))=""
|
|
D ^%ZTLOAD K ^TMP("PSDRPT",$J),ZTSK
|
|
END K %,%H,%I,%ZIS,ALL,C,CNT,COPY,COMM,DA,DIC,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,EXP,EXPD,EXP1,FLAG,LOT,MFG,NAOU,NEWBAL,NODE,NUM
|
|
K FNOTE,OK,ORD,ORDN,POP,PSD,PSDA,PSDCPY,PSDDT,PSDEV,PSDG,PSDIO,PSDN,PSDNA,PSDPT,PSDR,PSDRN,PSDS,PSDSN,PSDT,PSDSN,PSDST,PSDYR,QTY,REQD,REQDT,SEL,STAT,STATN,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
|
|
K ^TMP("PSDRPT",$J) D ^%ZISC
|
|
S:$D(ZTQUEUED) ZTREQ="@"
|
|
Q
|