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