35 lines
2.1 KiB
Mathematica
35 lines
2.1 KiB
Mathematica
PSDGSH1 ;BIR/JPW-Review Green Sheet History (cont'd) ; 6 Jan 94
|
|
;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
|
|
START ;
|
|
S CNT=0,NODE15=$G(^PSD(58.81,PSDA,1.5)),NODE16=$G(^PSD(58.81,PSDA,1.6))
|
|
S PSDDT=$P(NODE,"^",4) I PSDDT S PSDDT=$$FMTE^XLFDT(PSDDT,"2P")
|
|
S MFG=$P(NODE,"^",13),LOT=$P(NODE,"^",14),EXP=$P(NODE,"^",15) I EXP S Y=EXP X ^DD("DD") S EXP=Y
|
|
S STAT=+$P(NODE,"^",11),PSDPN=$P(NODE,"^",17),STAT=$P($G(^PSD(58.82,STAT,0)),"^")
|
|
S NAOU=+$P(NODE,"^",18),NAOU=$P($G(^PSD(58.8,+NAOU,0)),"^"),DRUG=+$P(NODE,"^",5),DRUG=$P($G(^PSDRUG(+DRUG,0)),"^")
|
|
S COMP=+$P(NODE,"^",12),COMP=$P($G(^PSD(58.83,+COMP,0)),"^"),QTY=+$P(NODE,"^",6)
|
|
S CDT=$P(NODE,"^",19) I CDT S CDT=$$FMTE^XLFDT(CDT,"2P")
|
|
S REAS=$P(NODE,"^",16),PSDI=+$P(NODE,"^",7)
|
|
S PSDTP=$P(NODE15,"^",2),PSDIP=$P(NODE15,"^",3),PSDIR=$P(NODE15,"^",4)
|
|
S PSDUZA=$P(NODE15,"^",2)
|
|
I PSDUZA S PSDUZAN=$P($G(^VA(200,+PSDUZA,0)),"^")
|
|
I PSDTP S PSDTP=$$FMTE^XLFDT(PSDTP,"2P")
|
|
I PSDIP S PSDIP=$$FMTE^XLFDT(PSDIP,"2P")
|
|
I PSDIR S PSDIR=$$FMTE^XLFDT(PSDIR,"2P")
|
|
I PSDI S PSDIN=$P($G(^VA(200,+PSDI,0)),"^")
|
|
I $D(^PSD(58.81,PSDA,1)) S NODE1=^(1) D SET1^PSDGSH11
|
|
I $D(^PSD(58.81,PSDA,3)) S NODE3=^(3) D SET3^PSDGSH11
|
|
I $D(^PSD(58.81,PSDA,4)) S NODE4=^(4) D SET4^PSDGSH11
|
|
I $D(^PSD(58.81,PSDA,5)) S NODE5=^(5) D SET5^PSDGSH11
|
|
I $D(^PSD(58.81,PSDA,7)) S NODE7=^(7) D SET7^PSDGSH11
|
|
I $D(^PSD(58.81,PSDA,1.5)) S NODE15=^(1.5) D SET15^PSDGSH11
|
|
I $D(^PSD(58.81,PSDA,1.6)) S NODE16=^(1.6)
|
|
D DISPLAY^PSDGSH2
|
|
DONE I $E(IOST)'="C" W @IOF
|
|
I $E(IOST,1,2)="C-",'PSDOUT W ! K DIR,DIRUT S DIR(0)="EA",DIR("A")="END OF REPORT! Press <RET> to return to the menu" D ^DIR K DIR
|
|
END K %,%DT,%H,%I,%ZIS,C,CANCD,CANCPH,CANCQ,CBY,CDT,CNT,COMP,CREAS,COMM,D,DA,DESD,DESDP,DEST,DESTD,DESTH,DESTQ,DIC,DIW,DIWF,DIWL,DIWR,DIWT,DN,DREAS,DRUG,DTOUT,DUOUT
|
|
K EDADJ,EDMFG,EDPH,EDQTY,EDT,EREAS,EXP,FILL,JJ,LN,LOT,MFG,NAOU,NEW,NODE,NODE1,NODE3,NODE4,NODE5,NODE7,NODE15,NODE16,NURSF,NURST,OK,ORC,ORCD,OTR
|
|
K PG,PROC,POP,PSDA,PSDBY,PSDDT,PSDEV,PSDI,PSDIN,PSDIP,PSDIR,PSDOUT,PSDPN,PSDTP,PSDUZA,PSDUZAN,PUBY,PUDT
|
|
K QTY,REAS,REQ,REQD,RETN,RTECH,SREAS,STAT,STATN,STKD,STKQ,TEXT,TFRD,TFRN,TFTD,TFTN,TQTY,TRANS,TRN,X,Y,Z
|
|
D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
|
|
Q
|