| [613] | 1 | PSGO ;BIR/CML3,MV-PRINTS PATIENT'S ORDERS ;10 Feb 98 / 1:32 PM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**4,58,110**;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference to ^PS(55 is is supported by DBIA #2191.
|
|---|
| 5 | ;
|
|---|
| 6 | K ^TMP("PSJON",$J),PSGONF S PSGOH="U N I T D O S E P R O F I L E" D ENGORD^PSGOU
|
|---|
| 7 | ;
|
|---|
| 8 | EN ;
|
|---|
| 9 | S CML=IO'=IO(0)!($E(IOST,1,2)'="C-"),NP="" N RB
|
|---|
| 10 | U IO D GET I '$D(^TMP("PSG",$J)) W !,SLS,SLS,$E(SLS,1,24),!?22,"NO ORDERS FOUND" W:"SL"[PSGOL " FOR A ",$S(PSGOL="S":"SHORT",1:"LONG")," PROFILE."
|
|---|
| 11 | G:NP["^" DONE
|
|---|
| 12 | E S (C,DRG)="",LD=0
|
|---|
| 13 | E D DRG G:NP["^" DONE
|
|---|
| 14 | I CML,$S('$D(PSGPRP):1,1:PSGPRP="P") D BOT
|
|---|
| 15 | ;
|
|---|
| 16 | DONE ;
|
|---|
| 17 | I $S('$D(PSGPRP):1,1:PSGPRP="P") K ^TMP("PSG",$J)
|
|---|
| 18 | S PSGON=$S('CML:ON,1:0) K:'$D(PSGVBW) PSGODT
|
|---|
| 19 | ;
|
|---|
| 20 | D1 ;
|
|---|
| 21 | K C,CML,DN,DO,DRG,F,GIVE,HDT,LN2,NF,ND,ND4,ND6,NP,O,ON,PF,PG,PSGHD,PSGOH,PSJTEAM,RCT,RF,RTE,S,SCH,SD,SLS,SM,ST,STS,TF,UDU,V,WD,WS,WT Q
|
|---|
| 22 | ;
|
|---|
| 23 | DRG ;
|
|---|
| 24 | I PSGOL'="N" F S C=$O(^TMP("PSG",$J,C)) Q:C=""!(NP["^") D:$S(C="BA":1,C="CC":1,C="CD":1,C["C":TF,1:1) TF F ST="C","O","OC","P","R","z" D
|
|---|
| 25 | .F S DRG=$O(^TMP("PSG",$J,C,ST,DRG)) Q:DRG=""!(NP["^") S NF=^(DRG),O=$P(DRG,"^",2),DN=$P(DRG,"^") D:$Y+4>IOSL NP Q:NP["^" D P
|
|---|
| 26 | I PSGOL="N" F S LD=$O(^TMP("PSG",$J,LD)) Q:'LD S X=^(LD),NF=$P(X,U),C=$P(X,U,2),ST=$P(X,U,3),DN=$P(X,U,4),O=$P(LD,U,2) D P
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | P ;Display drug data stored in ^TMP("PSG",$J
|
|---|
| 30 | S ON=ON+1 I 'CML S ^TMP("PSJON",$J,ON)=+O_$S(C["CD":"",C["C":"P",C["BD":"",C["B":"P",1:"U") S:C'["O" PSGONC=ON
|
|---|
| 31 | Q:PSGOL="N"
|
|---|
| 32 | W !,$J(ON,4),?5
|
|---|
| 33 | I C["CD" N PSJO,OO S PSJO=O,OO=0 F S OO=$O(^PS(53.1,"ACX",PSJO,OO)) Q:'OO S O=OO D P2 W !
|
|---|
| 34 | I C["BD" N PSJO,OO S PSJO=O,OO=0 F S OO=$O(^PS(53.1,"ACX",PSJO,OO)) Q:'OO S O=OO D P2 W !
|
|---|
| 35 | Q:C["BD" Q:C["CD"
|
|---|
| 36 | ; naked references below refer to full reference inside indirection @(F_+O_".0)" for either file 53.1 or 55
|
|---|
| 37 | P2 S ND=$G(@(F_+O_",0)")),SCH=$G(^(2)),ND4=$G(^(4)),ND6=$G(^(6)),DO=$G(^(.2))
|
|---|
| 38 | I C="A",PSJSYSU,'$P(ND4,"^",+PSJSYSU),$P(ND4,"^",+PSJSYSU=1+9) S PSGONV=ON
|
|---|
| 39 | I C="A"!(C="O") S:$P(ND,"^",9)'="H"&'CML PSGONR=ON D
|
|---|
| 40 | .S V='$P(ND4,"^",UDU),V=$S(+PSJSYSU=1&V:1,+PSJSYSU=3&V:1,1:0)
|
|---|
| 41 | .W $S(ND4="":" ",$P(ND4,"^",12):"D",V!$P(ND4,"^",19)&$P(ND4,"^",18):"H",V!$P(ND4,"^",23)&$P(ND4,"^",22):"H",V!$P(ND4,"^",16)&$P(ND4,"^",15):"R",1:" ")
|
|---|
| 42 | .W $S($P(DO,U,4)="D":"d",1:" ")_$S(V:"->",1:" ")
|
|---|
| 43 | ;I C="CA"!(C["B") W $S($P(ND4,"^",12):"D",1:" "),$S(PSJSYSU:"->",1:"") I C["B" S PSGONF=$S('$G(PSGONF):ON_U_ON,1:+PSGONF_U_ON)
|
|---|
| 44 | I C="CA"!(C["B") W $S($P(ND4,"^",12):"D",1:" ") I C["B" S PSGONF=$S('$G(PSGONF):ON_U_ON,1:+PSGONF_U_ON)
|
|---|
| 45 | S SM=2-$S('$P(ND,"^",5):2,1:$P(ND,"^",6)),STS=$S($P(ND,"^",9)]"":$P(ND,"^",9),1:"NF"),PF=$E("*",$P(ND,"^",20)>0),PSGID=$P(SCH,"^",2),SD=$P(SCH,"^",4) I C["C" S (PSGID,SD)="",PSGOD="********"
|
|---|
| 46 | I STS="A",($P(ND,U,27)="R") S STS="R"
|
|---|
| 47 | S WS=0,PSGOD=$$ENDTC^PSGMI(PSGID)
|
|---|
| 48 | S:PSJPWD WS=$$WS^PSJO(PSJPWD,PSGP,F,+O)
|
|---|
| 49 | NEW MARX
|
|---|
| 50 | D DRGDISP^PSJLMUT1(PSGP,+O_$S(C["B":"P",C["C":"P",1:"U"),40,54,.MARX,0)
|
|---|
| 51 | NEW X F X=0:0 S X=$O(MARX(X)) Q:'X W @($S(X=1:"?9",1:"!?11")) W MARX(X) D:X=1
|
|---|
| 52 | . N RNDT,O2 S O2=O S:+O2=O O2=O2_"P" S RNDT=$$LASTREN^PSJLMPRI(PSGP,O2) I RNDT]"" S RNDT=$E($$ENDTC^PSGMI(RNDT),1,5)
|
|---|
| 53 | . W ?50,$S(C["C":"?",ST'="z":ST,1:"?"),?53,$E(PSGOD,1,5)
|
|---|
| 54 | . S SD=$$ENDTC^PSGMI(SD) W ?60,$E(SD,1,5),?67,STS
|
|---|
| 55 | . I NF!WS!SM!PF!RNDT W ?71 W:NF "NF " W:WS "WS " W:RNDT RNDT_" " W:SM $E("HSM",SM,3) W:PF ?79,"*"
|
|---|
| 56 | I ND6]"" S Y=$$ENSET^PSGSICHK($P(ND6,"^")) W !?11 F X=1:1:$L(Y," ") S V=$P(Y," ",X) W:$L(V)+$X>66 !?11 W V_" "
|
|---|
| 57 | Q
|
|---|
| 58 | ;
|
|---|
| 59 | TF ;
|
|---|
| 60 | NEW SLS S SLS="",$P(SLS," -",40)=""
|
|---|
| 61 | S LN2=$S(C="A":"A C T I V E",C["CC":"P E N D I N G R E N E W A L S",C["CD":"P E N D I N G C O M P L E X",C["C":"P E N D I N G ",C["BD":"N O N - V E R I F E D C O M P L E X",C["B":"N O N - V E R I F I E D",1:"N O N - A C T I V E")
|
|---|
| 62 | W:$D(^TMP("PSG",$J,C)) !,$E($E(SLS,1,(80-$L(LN2))/2)_" "_LN2_$E(SLS,1,(80-$L(LN2))/2),1,80)
|
|---|
| 63 | S F="^PS("_$S(C["C":"53.1,",C["B":"53.1,",1:"55,"_PSGP_",5,",1:"53.1,") S TF=$S(C["C":0,1:TF)
|
|---|
| 64 | Q
|
|---|
| 65 | ;
|
|---|
| 66 | GET ;
|
|---|
| 67 | S $P(LN2,"-",81)="",PG=$D(PSGVWA),(ON,PSGONC,PSGONR,PSGONV,SLS)="",$P(SLS," -",15)="",TF=1,RB=$S(PSJPRB]"":PSJPRB,1:"*NF*"),WD=$S(PSJPWDN]"":PSJPWDN,PSJPWD:PSJPWD_";DIC(42,",1:"*NF*")
|
|---|
| 68 | ;
|
|---|
| 69 | NP I ON,'CML W $C(7) R !," '^' TO QUIT ",NP:DTIME W:'$T $C(7) S:'$T NP="^" W:NP'["^" $C(13)," ",$C(13),# Q
|
|---|
| 70 | I ON,CML D BOT
|
|---|
| 71 | Q:$G(PSGOL)="N"
|
|---|
| 72 | ;
|
|---|
| 73 | HEADER ;
|
|---|
| 74 | S PG=PG+1
|
|---|
| 75 | S:'$D(PSJOPC) PSJOPC=1 S PSJTEAM=$S($D(PSJSEL("TM")):1,1:0)
|
|---|
| 76 | D ENTRY^PSJHEAD(PSGP,PSJOPC,PG,$G(PSJNARC),PSJTEAM)
|
|---|
| 77 | W:PG>1 !,$E(LN2,1,80) Q
|
|---|
| 78 | ;
|
|---|
| 79 | BOT ;
|
|---|
| 80 | F Q=$Y:1:IOSL-4 W !
|
|---|
| 81 | W !,?2,$P(PSGP(0),"^"),?40,PSJPPID,?70,$E($P(PSJPDOB,"^",2),1,8) Q
|
|---|
| 82 | ;
|
|---|
| 83 | ENHEAD ;
|
|---|
| 84 | K LN2,PSGPR,PSGPRP D NOW^%DTC S HDT=$$ENDTC^PSGMI(+$E(%,1,12)),PSGVWA=1,PSGOH="U N I T D O S E P R O F I L E" D GET
|
|---|
| 85 | D D1 K PSGONC,PSGONR,PSGONV,PSGVWA Q
|
|---|
| 86 | ;
|
|---|
| 87 | ENVBW ;
|
|---|
| 88 | S PSGOH=$S(PSGVBWTO=1:"N O N - V E R I F I E D O R D E R S",PSGVBWTO=2:"P E N D I N G O R D E R S",1:"N O N - V E R I F I E D / P E N D I N G O R D E R S")
|
|---|
| 89 | D EN Q
|
|---|
| 90 | ENPR ;
|
|---|
| 91 | S PSGOH="U N I T D O S E P R O F I L E" G GET
|
|---|
| 92 | Q
|
|---|
