Routine: PSDGSH1

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="@"

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

PSDGSH1.m