- PSJPR0 ;BIR/CML3,PR-INPATIENT MEDS PROFILE - GATHER ORDERS ;2/3/92 15:43 [ 12/16/97 2:07 PM ]
- ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
- ;
- D NOW^%DTC S PSGDT=%,(X1,DT)=$P(%,"."),X2=-2 D C^%DTC S PSGODT=X_(PSGDT#1),PSGID=PSGDT,HDT=$$ENDTC^PSGMI(PSGDT) K ^UTILITY("PSG",$J)
- W !!,"...a few moments, please..." D ENUNM^PSGOU
- S C="A",ST="O" F SD=PSGPAD:0 S SD=$O(^PS(55,PSGP,5,"AU","O",SD)) Q:'SD F O=0:0 S O=$O(^PS(55,PSGP,5,"AU","O",SD,O)) Q:'O D OCHK
- F ST="C","OC","P","R" F SD=PSGPAD:0 S SD=$O(^PS(55,PSGP,5,"AU",ST,SD)) Q:'SD F O=0:0 S O=$O(^PS(55,PSGP,5,"AU",ST,SD,O)) Q:'O D ECHK
- F ON=0:0 S ON=$O(^PS(55,DFN,"IV",ON)) Q:'ON I $D(^(ON,0)) D CHK^PSIVACT K PS S ST=$P(^PS(55,DFN,"IV",ON,0),"^",17) S IV=$S(ST="D":1,1:$P(^(0),"^",3)'>PSGDT),C=$E("O",IV)_"IV" D:'IV!(PSGOL="L"&IV) IV
- F SD="I","N" F O=0:0 S O=$O(^PS(53.1,"AS",SD,PSGP,O)) Q:'O S ST=$S('$D(^PS(53.1,O,0)):"z",$P(^(0),"^",7)]"":$P(^(0),"^",7),1:"z"),DRG=$S($D(^(1,1,0)):+^(0),1:""),C="N"_$S(SD="N":"X",1:"Y") D SET
- Q
- ;
- OCHK ;
- S C="A" G:SD>PSGDT!$S('PSJSYSU:0,'$D(^PS(55,PSGP,5,O,0)):0,"D"[$E($P(^(0),"^",9)):0,'$D(^(4)):1,'$P(^(4),"^",+PSJSYSU):1,SD<PSGODT:0,1:$P(^(4),"^",16)) DS Q:PSGOL["S" S C="O" G DS
- ;
- ECHK ;
- S C="A" G:SD>PSGDT!$S(SD<PSGODT:0,'$D(^PS(55,PSGP,5,O,0)):0,$P(^(0),"^",9)'="E":0,'$D(^(4)):0,1:$P(^(4),"^",16)) DS Q:PSGOL="S" S C="O" G DS
- ;
- IV ;
- S ^UTILITY("PSG",$J,C,ST,$S('$D(^PS(52.6,+$O(^PS(DFN,"IV",ON,"AD",0)),0)):"z",$P(^(0),"^")]"":$P(^(0),"^"),1:"z"),ON)="" Q
- ;
- DS S DRG=$S($D(^PS(55,PSGP,5,O,1,1,0)):+^(0),1:0)
- SET S ^UTILITY("PSG",$J,C,ST,$S('$D(^PSDRUG(DRG,0)):"z",$P(^(0),"^")]"":$P(^(0),"^"),1:"z"),O)="" Q
- ;
- PSJPR0 ;BIR/CML3,PR-INPATIENT MEDS PROFILE - GATHER ORDERS ;2/3/92 15:43 [ 12/16/97 2:07 PM ]
- +1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
- +2 ;
- +3 DO NOW^%DTC
- SET PSGDT=%
- SET (X1,DT)=$PIECE(%,".")
- SET X2=-2
- DO C^%DTC
- SET PSGODT=X_(PSGDT#1)
- SET PSGID=PSGDT
- SET HDT=$$ENDTC^PSGMI(PSGDT)
- KILL ^UTILITY("PSG",$JOB)
- +4 WRITE !!,"...a few moments, please..."
- DO ENUNM^PSGOU
- +5 SET C="A"
- SET ST="O"
- FOR SD=PSGPAD:0
- SET SD=$ORDER(^PS(55,PSGP,5,"AU","O",SD))
- IF 'SD
- QUIT
- FOR O=0:0
- SET O=$ORDER(^PS(55,PSGP,5,"AU","O",SD,O))
- IF 'O
- QUIT
- DO OCHK
- +6 FOR ST="C","OC","P","R"
- FOR SD=PSGPAD:0
- SET SD=$ORDER(^PS(55,PSGP,5,"AU",ST,SD))
- IF 'SD
- QUIT
- FOR O=0:0
- SET O=$ORDER(^PS(55,PSGP,5,"AU",ST,SD,O))
- IF 'O
- QUIT
- DO ECHK
- +7 FOR ON=0:0
- SET ON=$ORDER(^PS(55,DFN,"IV",ON))
- IF 'ON
- QUIT
- IF $DATA(^(ON,0))
- DO CHK^PSIVACT
- KILL PS
- SET ST=$PIECE(^PS(55,DFN,"IV",ON,0),"^",17)
- SET IV=$SELECT(ST="D":1,1:$PIECE(^(0),"^",3)'>PSGDT)
- SET C=$EXTRACT("O",IV)_"IV"
- IF 'IV!(PSGOL="L"&IV)
- DO IV
- +8 FOR SD="I","N"
- FOR O=0:0
- SET O=$ORDER(^PS(53.1,"AS",SD,PSGP,O))
- IF 'O
- QUIT
- SET ST=$SELECT('$DATA(^PS(53.1,O,0)):"z",$PIECE(^(0),"^",7)]"":$PIECE(^(0),"^",7),1:"z")
- SET DRG=$SELECT($DATA(^(1,1,0)):+^(0),1:"")
- SET C="N"_$SELECT(SD="N":"X",1:"Y")
- DO SET
- +9 QUIT
- +10 ;
- OCHK ;
- +1 SET C="A"
- IF SD>PSGDT!$SELECT('PSJSYSU
- GOTO DS
- IF PSGOL["S"
- QUIT
- SET C="O"
- GOTO DS
- +2 ;
- ECHK ;
- +1 SET C="A"
- IF SD>PSGDT!$SELECT(SD<PSGODT
- GOTO DS
- IF PSGOL="S"
- QUIT
- SET C="O"
- GOTO DS
- +2 ;
- IV ;
- +1 SET ^UTILITY("PSG",$JOB,C,ST,$SELECT('$DATA(^PS(52.6,+$ORDER(^PS(DFN,"IV",ON,"AD",0)),0)):"z",$PIECE(^(0),"^")]"":$PIECE(^(0),"^"),1:"z"),ON)=""
- QUIT
- +2 ;
- DS SET DRG=$SELECT($DATA(^PS(55,PSGP,5,O,1,1,0)):+^(0),1:0)
- SET SET ^UTILITY("PSG",$JOB,C,ST,$SELECT('$DATA(^PSDRUG(DRG,0)):"z",$PIECE(^(0),"^")]"":$PIECE(^(0),"^"),1:"z"),O)=""
- QUIT
- +1 ;
