Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSDGSH11

PSDGSH11.m

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