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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDGSH1 2206 printed Oct 16, 2024@17:47:01 Page 2
PSDGSH1 ;BIR/JPW-Review Green Sheet History (cont'd) ; 6 Jan 94
+1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
START ;
+1 SET CNT=0
SET NODE15=$GET(^PSD(58.81,PSDA,1.5))
SET NODE16=$GET(^PSD(58.81,PSDA,1.6))
+2 SET PSDDT=$PIECE(NODE,"^",4)
IF PSDDT
SET PSDDT=$$FMTE^XLFDT(PSDDT,"2P")
+3 SET MFG=$PIECE(NODE,"^",13)
SET LOT=$PIECE(NODE,"^",14)
SET EXP=$PIECE(NODE,"^",15)
IF EXP
SET Y=EXP
XECUTE ^DD("DD")
SET EXP=Y
+4 SET STAT=+$PIECE(NODE,"^",11)
SET PSDPN=$PIECE(NODE,"^",17)
SET STAT=$PIECE($GET(^PSD(58.82,STAT,0)),"^")
+5 SET NAOU=+$PIECE(NODE,"^",18)
SET NAOU=$PIECE($GET(^PSD(58.8,+NAOU,0)),"^")
SET DRUG=+$PIECE(NODE,"^",5)
SET DRUG=$PIECE($GET(^PSDRUG(+DRUG,0)),"^")
+6 SET COMP=+$PIECE(NODE,"^",12)
SET COMP=$PIECE($GET(^PSD(58.83,+COMP,0)),"^")
SET QTY=+$PIECE(NODE,"^",6)
+7 SET CDT=$PIECE(NODE,"^",19)
IF CDT
SET CDT=$$FMTE^XLFDT(CDT,"2P")
+8 SET REAS=$PIECE(NODE,"^",16)
SET PSDI=+$PIECE(NODE,"^",7)
+9 SET PSDTP=$PIECE(NODE15,"^",2)
SET PSDIP=$PIECE(NODE15,"^",3)
SET PSDIR=$PIECE(NODE15,"^",4)
+10 SET PSDUZA=$PIECE(NODE15,"^",2)
+11 IF PSDUZA
SET PSDUZAN=$PIECE($GET(^VA(200,+PSDUZA,0)),"^")
+12 IF PSDTP
SET PSDTP=$$FMTE^XLFDT(PSDTP,"2P")
+13 IF PSDIP
SET PSDIP=$$FMTE^XLFDT(PSDIP,"2P")
+14 IF PSDIR
SET PSDIR=$$FMTE^XLFDT(PSDIR,"2P")
+15 IF PSDI
SET PSDIN=$PIECE($GET(^VA(200,+PSDI,0)),"^")
+16 IF $DATA(^PSD(58.81,PSDA,1))
SET NODE1=^(1)
DO SET1^PSDGSH11
+17 IF $DATA(^PSD(58.81,PSDA,3))
SET NODE3=^(3)
DO SET3^PSDGSH11
+18 IF $DATA(^PSD(58.81,PSDA,4))
SET NODE4=^(4)
DO SET4^PSDGSH11
+19 IF $DATA(^PSD(58.81,PSDA,5))
SET NODE5=^(5)
DO SET5^PSDGSH11
+20 IF $DATA(^PSD(58.81,PSDA,7))
SET NODE7=^(7)
DO SET7^PSDGSH11
+21 IF $DATA(^PSD(58.81,PSDA,1.5))
SET NODE15=^(1.5)
DO SET15^PSDGSH11
+22 IF $DATA(^PSD(58.81,PSDA,1.6))
SET NODE16=^(1.6)
+23 DO DISPLAY^PSDGSH2
DONE IF $EXTRACT(IOST)'="C"
WRITE @IOF
+1 IF $EXTRACT(IOST,1,2)="C-"
IF 'PSDOUT
WRITE !
KILL DIR,DIRUT
SET DIR(0)="EA"
SET DIR("A")="END OF REPORT! Press <RET> to return to the menu"
DO ^DIR
KILL DIR
END KILL %,%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
+1 KILL 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
+2 KILL PG,PROC,POP,PSDA,PSDBY,PSDDT,PSDEV,PSDI,PSDIN,PSDIP,PSDIR,PSDOUT,PSDPN,PSDTP,PSDUZA,PSDUZAN,PUBY,PUDT
+3 KILL QTY,REAS,REQ,REQD,RETN,RTECH,SREAS,STAT,STATN,STKD,STKQ,TEXT,TFRD,TFRN,TFTD,TFTN,TQTY,TRANS,TRN,X,Y,Z
+4 DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+5 QUIT
