| 1 | PSDPDR1 ;BIR/BJW-Narc Disp/Rec Report (VA FORM 10-2321) (cont'd) ; 03 Mar 98
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;**8**;13 Feb 97
|
|---|
| 3 | ;**Y2K compliance** display 4 digit year on va forms
|
|---|
| 4 | START ;compile data
|
|---|
| 5 | K ^TMP("PSDRPT",$J)
|
|---|
| 6 | 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
|
|---|
| 7 | 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)=""
|
|---|
| 8 | 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
|
|---|
| 9 | .S NODE=^PSD(58.81,PSDA,0),PSDN=+$P(NODE,"^",18)
|
|---|
| 10 | .I $D(NAOU(PSDN)) S PSDNA=$S($P($G(^PSD(58.8,PSDN,0)),"^")]"":$P(^(0),"^"),1:"ZZ/"_PSDN) D
|
|---|
| 11 | ..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)
|
|---|
| 12 | ..S STATN=$S($P($G(^PSD(58.82,STAT,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
|
|---|
| 13 | ..S QTY=$P(NODE,"^",6) I $D(^PSD(58.81,PSDA,4)),+$P(^(4),"^",3) S QTY=$P(^(4),"^",3)
|
|---|
| 14 | ..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=""
|
|---|
| 15 | ..;;The next two lines inserted for E3R# 3311 2-9-95.
|
|---|
| 16 | ..S:$D(^PSD(58.81,PSDA,4)) NEWBAL=$P(^(4),"^",7)+$P(^(4),"^",4),FNOTE="*"
|
|---|
| 17 | ..S:'$D(^PSD(58.81,PSDA,4)) NEWBAL=$P(NODE,"^",10)-QTY,FNOTE=""
|
|---|
| 18 | ..I EXP S (EXP1,EXPD)=$$FMTE^XLFDT(EXP,"5D") S:'$P(EXP1,"/",2) EXPD=$P(EXP1,"/")_"/"_$P(EXP1,"/",3) S EXP=EXPD
|
|---|
| 19 | ..S NUM=$S($P(NODE,"^",17)]"":$P(NODE,"^",17),1:"UNKNOWN")
|
|---|
| 20 | ..S ORD=+$P($G(^PSD(58.81,PSDA,1)),"^",7),ORDN=$S($P($G(^VA(200,ORD,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
|
|---|
| 21 | ..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
|
|---|
| 22 | ..S PSDST=$P(NODE,"^",4),PSDDT="" I PSDST S Y=PSDST X ^DD("DD") S PSDYR=$P(Y,",",2),PSDYR=$E(PSDYR,1,4)
|
|---|
| 23 | ..S PSDDT=$E(PSDST,4,5)_"/"_$E(PSDST,6,7)_"/"_PSDYR
|
|---|
| 24 | ..;;Fnote and Newbal added for E3R# 3311 2-9-95.
|
|---|
| 25 | ..S ^TMP("PSDRPT",$J,PSDNA,NUM)=PSDRN_"^"_QTY_FNOTE_"^"_PSDDT_"^"_REQDT_"^"_ORDN_"^"_MFG_"^"_LOT_"^"_EXPD_"^"_COMM_"^"_PSDA_"^"_NEWBAL_"^"_FNOTE
|
|---|
| 26 | Q
|
|---|
| 27 | PRTQUE ;queues print after compile
|
|---|
| 28 | K ZTSAVE,ZTIO S ZTIO=PSDIO,ZTRTN="PRINT^PSDPDR2",ZTDESC="Print Narcotic Disp Report",ZTDTH=$H
|
|---|
| 29 | S (ZTSAVE("^TMP(""PSDRPT"",$J,"),ZTSAVE("PSDS"),ZTSAVE("PSDPT"),ZTSAVE("CNT"),ZTSAVE("PSDCPY"))=""
|
|---|
| 30 | D ^%ZTLOAD K ^TMP("PSDRPT",$J),ZTSK
|
|---|
| 31 | 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
|
|---|
| 32 | 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
|
|---|
| 33 | K ^TMP("PSDRPT",$J) D ^%ZISC
|
|---|
| 34 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 35 | Q
|
|---|
