72 lines
3.3 KiB
Mathematica
72 lines
3.3 KiB
Mathematica
|
PSDGSH11 ;BIR/JPW-Review Green Sheet History (cont'd) ; 24 Aug 94
|
||
|
|
;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
|
||
|
|
SET1 ;
|
||
|
|
I +$P(NODE,"^",2)=12 S PSDDT=$P(NODE1,"^",2) I PSDDT S PSDDT=$$FMTE^XLFDT(PSDDT,"2P")
|
||
|
|
S PSDBY=$P(NODE1,"^") I PSDBY S PSDBY=$P($G(^VA(200,+PSDBY,0)),"^")
|
||
|
|
S PROC=$P(NODE1,"^",2) I PROC S PROC=$$FMTE^XLFDT(PROC,"2P")
|
||
|
|
S ORC=$P(NODE1,"^",3) I ORC S ORC=$P($G(^VA(200,+ORC,0)),"^")
|
||
|
|
S ORCD=$P(NODE1,"^",4) I ORCD S ORCD=$$FMTE^XLFDT(ORCD,"2P")
|
||
|
|
S FILL=$P(NODE1,"^",5) I FILL S FILL=$P($G(^VA(200,+FILL,0)),"^")
|
||
|
|
S REQD=$P(NODE1,"^",6) I REQD S REQD=$$FMTE^XLFDT(REQD,"2P")
|
||
|
|
S REQ=$P(NODE1,"^",7) I REQ S REQ=$P($G(^VA(200,+REQ,0)),"^")
|
||
|
|
S RTECH=$P(NODE1,"^",11) I RTECH S RTECH=$P($G(^VA(200,+RTECH,0)),"^")
|
||
|
|
SET1N S RETN=$P(NODE1,"^",10) I RETN S RETN=$P($G(^VA(200,+RETN,0)),"^")
|
||
|
|
S PUDT=$P(NODE1,"^",12) I PUDT S PUDT=$$FMTE^XLFDT(PUDT,"2P")
|
||
|
|
S PUBY=$P(NODE1,"^",13) I PUBY S PUBY=$P($G(^VA(200,+PUBY,0)),"^")
|
||
|
|
S CBY=$P(NODE1,"^",14) I CBY S CBY=$P($G(^VA(200,+CBY,0)),"^")
|
||
|
|
S OTR=$P(NODE1,"^",15)
|
||
|
|
Q
|
||
|
|
SET3 ;
|
||
|
|
S STKD=$P(NODE3,"^") I STKD S STKD=$$FMTE^XLFDT(STKD,"2P")
|
||
|
|
S STKQ=+$P(NODE3,"^",2),SREAS=$P(NODE3,"^",3)
|
||
|
|
S DESTD=$P(NODE3,"^",4) I DESTD S DESTD=$$FMTE^XLFDT(DESTD,"2P")
|
||
|
|
S DESTQ=+$P(NODE3,"^",5),DESTH=+$P(NODE3,"^",8),DREAS=$P(NODE3,"^",6)
|
||
|
|
S DESD=$P($G(^PSD(58.86,+DESTH,0)),"^",11),DESDP=$P($G(^(0)),"^",10)
|
||
|
|
I DESD S DESD=$$FMTE^XLFDT(DESD,"2P")
|
||
|
|
I DESDP S DESDP=$P($G(^VA(200,+DESDP,0)),"^")
|
||
|
|
Q
|
||
|
|
SET4 ;
|
||
|
|
S EDT=$P(NODE4,"^") I EDT S EDT=$$FMTE^XLFDT(EDT,"2P")
|
||
|
|
S EDPH=$P(NODE4,"^",2) I EDPH S EDPH=$P($G(^VA(200,+EDPH,0)),"^")
|
||
|
|
S EDQTY=+$P(NODE4,"^",3),EDADJ=+$P(NODE4,"^",4),EDMFG=+$P(NODE4,"^",5),EREAS=$P(NODE4,"^",6)
|
||
|
|
Q
|
||
|
|
SET5 ;
|
||
|
|
S CANCD=$P(NODE5,"^") I CANCD S CANCD=$$FMTE^XLFDT(CANCD,"2P")
|
||
|
|
S CANCPH=$P(NODE5,"^",2) I CANCPH S CANCPH=$P($G(^VA(200,+CANCPH,0)),"^")
|
||
|
|
S CANCQ=+$P(NODE5,"^",3),CREAS=$P(NODE5,"^",4)
|
||
|
|
Q
|
||
|
|
SET7 ;
|
||
|
|
Q:'$D(^PSD(58.81,PSDA,7)) S TRANS=1
|
||
|
|
S CNT=CNT+1
|
||
|
|
S TFRD=+$P(NODE7,"^") I TFRD S TFRD=$$FMTE^XLFDT(TFRD,"2P")
|
||
|
|
S NURSF=+$P(NODE7,"^",2) I NURSF S NURSF=$P($G(^VA(200,+NURSF,0)),"^")
|
||
|
|
S TFRN=+$P(NODE,"^",18) I TFRN S TFRN=$P($G(^PSD(58.8,+TFRN,0)),"^")
|
||
|
|
S TFTD=+$P(NODE7,"^",4) I TFTD S TFTD=$$FMTE^XLFDT(TFTD,"2P")
|
||
|
|
S TFTN=+$P(NODE7,"^",3) I TFTN S TFTN=$P($G(^PSD(58.8,+TFTN,0)),"^")
|
||
|
|
S NURST=+$P(NODE7,"^",5) I NURST S NURST=$P($G(^VA(200,+NURST,0)),"^")
|
||
|
|
S TQTY=+$P(NODE7,"^",7),NEW=+$O(^PSD(58.81,"AE",PSDA,0))
|
||
|
|
S TRN(CNT)=TFRN_"^"_TFRD_"^"_NURSF_"^"_TFTN_"^"_TFTD_"^"_NURST_"^"_TQTY
|
||
|
|
I NEW S PSDA=NEW D SETN
|
||
|
|
Q
|
||
|
|
SETN ;
|
||
|
|
Q:'$D(^PSD(58.81,PSDA,0)) S NODE=^(0)
|
||
|
|
S TFTN=+$P(NODE,"^",18) I TFTN S TFTN=$P($G(^PSD(58.8,+TFTN,0)),"^") S:$P(TRN(CNT),"^",4)'=TFTN $P(TRN(CNT),"^",4)=TFTN
|
||
|
|
S STAT=+$P(NODE,"^",11),STAT=$P($G(^PSD(58.82,+STAT,0)),"^")
|
||
|
|
S COMP=+$P(NODE,"^",12),COMP=$P($G(^PSD(58.83,+COMP,0)),"^")
|
||
|
|
S CDT=+$P(NODE,"^",19) I CDT S CDT=$$FMTE^XLFDT(CDT,"2P")
|
||
|
|
I $D(^PSD(58.81,PSDA,1)) S NODE1=^(1) D SET1N
|
||
|
|
I $D(^PSD(58.81,PSDA,3)) S NODE3=^(3) D SET3
|
||
|
|
I $D(^PSD(58.81,PSDA,1.5)) S NODE15=^(1.5) D SET15
|
||
|
|
I $D(^PSD(58.81,PSDA,1.6)) S NODE16=^(1.6)
|
||
|
|
;Q:'$O(^PSD(58.81,"AE",PSDA,0))
|
||
|
|
I $P($G(^PSD(58.81,PSDA,7)),U) S NODE7=^(7) D SET7
|
||
|
|
Q
|
||
|
|
SET15 ;
|
||
|
|
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")
|
||
|
|
Q
|