| 1 | PSDGSH1 ;BIR/JPW-Review Green Sheet History (cont'd) ; 6 Jan 94
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
|
|---|
| 3 | START ;
|
|---|
| 4 | S CNT=0,NODE15=$G(^PSD(58.81,PSDA,1.5)),NODE16=$G(^PSD(58.81,PSDA,1.6))
|
|---|
| 5 | S PSDDT=$P(NODE,"^",4) I PSDDT S PSDDT=$$FMTE^XLFDT(PSDDT,"2P")
|
|---|
| 6 | S MFG=$P(NODE,"^",13),LOT=$P(NODE,"^",14),EXP=$P(NODE,"^",15) I EXP S Y=EXP X ^DD("DD") S EXP=Y
|
|---|
| 7 | S STAT=+$P(NODE,"^",11),PSDPN=$P(NODE,"^",17),STAT=$P($G(^PSD(58.82,STAT,0)),"^")
|
|---|
| 8 | S NAOU=+$P(NODE,"^",18),NAOU=$P($G(^PSD(58.8,+NAOU,0)),"^"),DRUG=+$P(NODE,"^",5),DRUG=$P($G(^PSDRUG(+DRUG,0)),"^")
|
|---|
| 9 | S COMP=+$P(NODE,"^",12),COMP=$P($G(^PSD(58.83,+COMP,0)),"^"),QTY=+$P(NODE,"^",6)
|
|---|
| 10 | S CDT=$P(NODE,"^",19) I CDT S CDT=$$FMTE^XLFDT(CDT,"2P")
|
|---|
| 11 | S REAS=$P(NODE,"^",16),PSDI=+$P(NODE,"^",7)
|
|---|
| 12 | S PSDTP=$P(NODE15,"^",2),PSDIP=$P(NODE15,"^",3),PSDIR=$P(NODE15,"^",4)
|
|---|
| 13 | S PSDUZA=$P(NODE15,"^",2)
|
|---|
| 14 | I PSDUZA S PSDUZAN=$P($G(^VA(200,+PSDUZA,0)),"^")
|
|---|
| 15 | I PSDTP S PSDTP=$$FMTE^XLFDT(PSDTP,"2P")
|
|---|
| 16 | I PSDIP S PSDIP=$$FMTE^XLFDT(PSDIP,"2P")
|
|---|
| 17 | I PSDIR S PSDIR=$$FMTE^XLFDT(PSDIR,"2P")
|
|---|
| 18 | I PSDI S PSDIN=$P($G(^VA(200,+PSDI,0)),"^")
|
|---|
| 19 | I $D(^PSD(58.81,PSDA,1)) S NODE1=^(1) D SET1^PSDGSH11
|
|---|
| 20 | I $D(^PSD(58.81,PSDA,3)) S NODE3=^(3) D SET3^PSDGSH11
|
|---|
| 21 | I $D(^PSD(58.81,PSDA,4)) S NODE4=^(4) D SET4^PSDGSH11
|
|---|
| 22 | I $D(^PSD(58.81,PSDA,5)) S NODE5=^(5) D SET5^PSDGSH11
|
|---|
| 23 | I $D(^PSD(58.81,PSDA,7)) S NODE7=^(7) D SET7^PSDGSH11
|
|---|
| 24 | I $D(^PSD(58.81,PSDA,1.5)) S NODE15=^(1.5) D SET15^PSDGSH11
|
|---|
| 25 | I $D(^PSD(58.81,PSDA,1.6)) S NODE16=^(1.6)
|
|---|
| 26 | D DISPLAY^PSDGSH2
|
|---|
| 27 | DONE I $E(IOST)'="C" W @IOF
|
|---|
| 28 | 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
|
|---|
| 29 | 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
|
|---|
| 30 | 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
|
|---|
| 31 | K PG,PROC,POP,PSDA,PSDBY,PSDDT,PSDEV,PSDI,PSDIN,PSDIP,PSDIR,PSDOUT,PSDPN,PSDTP,PSDUZA,PSDUZAN,PUBY,PUDT
|
|---|
| 32 | K QTY,REAS,REQ,REQD,RETN,RTECH,SREAS,STAT,STATN,STKD,STKQ,TEXT,TFRD,TFRN,TFTD,TFTN,TQTY,TRANS,TRN,X,Y,Z
|
|---|
| 33 | D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 34 | Q
|
|---|
