ROUTINE PSJLMUTL*7,67,58,85,111,160,198*

ROUTINE PSJLMUTL

PSJLMUTL * *  182 LINES,  8955 BYTES,  RSUM: 18527876/56399275 Page 1
        UCI: EHR,EHR    Site: Central Regional Hospital MAY 18,2015@15:09

PSJLMUTL^PSJLMUTL

PSJLMUTL^PSJLMUTL CODE

  1 PSJLMUTL --
            ;BIR/MLM-INPATIENT LISTMAN UTILITIES ; 9/12/07 10:28am
  2 +1     ;;5.0; INPATIENT MEDICATIONS ;**7,67,58,85,111,160,198**;16 DEC 97;
            Build 7
  3 +2     ;
  4 +3     ; Reference to ^ORD(101 is supported by DBIA #872.
  5 +4     ; Reference to ^PS(50.606 is supported by DBIA #2174.
  6 +5     ; Reference to ^PS(50.7 is supported by DBIA #2180.
  7 +6     ; Reference to ^PS(55 is supported by DBIA #2191.
  8 +7     ; Reference to ^PSDRUG is supported by DBIA #2192.
  9 +8     ; Reference to ^GMRAPEM0 is supported by DBIA #190.
 10 +9     ; Reference to ^SDAMA203 is supported by DBIA #4133.
 11 +10    ; Reference to ^VSIT is supported by DBIA #1905.
 12 +11    ;

NEWALL(DFN)^PSJLMUTL

NEWALL(DFN)^PSJLMUTL CODE

 13 NEWALL(DFN) --
            ; Enter Allergy info.
 14 +1     ;
 15 +2     D FULL^VALM1,EN2^GMRAPEM0
 16 +3     Q

DISALL(DFN)^PSJLMUTL

DISALL(DFN)^PSJLMUTL CODE

 17 DISALL(DFN) --
            ; Display brief patient info list.
 18 +1     K ^TMP("PSJALL",$J) N PSJLN,X,Y,PSGALG,PSGRALG,PSGLDR,PSJGMRAL,PSJW
            HERE S PSJWHERE="PSJLMUTL"
 19 +2     D ATS^PSJMUTL(57,57,2)
 20 +3     I (PSJGMRAL=0) S ^TMP("PSJALL",$J,1,0)=" Allergies/Reactions: "_"NK
            A",PSJLN=2 G NARRATIV
 21 +4     I (PSJGMRAL="") S ^TMP("PSJALL",$J,1,0)=" Allergies/Reactions: No A
            llergy Assessment",PSJLN=2 G NARRATIV
 22 +5     I ($G(PSGVALG(1))="NKA")!((PSGVALG=0)&(PSGALG=0)) D
 23 +6     .S ^TMP("PSJALL",$J,1,0)="           Allergies: "_$G(PSGVALG(1)),PS
            JLN=2,X=1
 24 +7     I ($G(PSGVALG(1))'="NKA")&((PSGVALG>0)!(PSGALG>0)) D
 25 +8     .S ^TMP("PSJALL",$J,1,0)="Allergies - Verified: "_$G(PSGVALG(1)),PS
            JLN=2,X=1
 26 +9     .F  S X=$O(PSGVALG(X)) Q:'X  S ^TMP("PSJALL",$J,PSJLN,0)="         
                           "_PSGVALG(X),PSJLN=PSJLN+1
 27 +10    .S ^TMP("PSJALL",$J,PSJLN,0)="        Non-Verified: "_$S($G(PSGALG(
            1))=0:"",1:$G(PSGALG(1))),PSJLN=PSJLN+1,X=1
 28 +11    .F  S X=$O(PSGALG(X)) Q:'X  S ^TMP("PSJALL",$J,PSJLN,0)="          
                          "_PSGALG(X),PSJLN=PSJLN+1
 29 +12    D RAD^PSJMUTL
 30 +13    I ($G(PSGVADR(1))="NKA")!((PSGVADR=0)&(PSGADR=0)) D
 31 +14    .S ^TMP("PSJALL",$J,PSJLN,0)="",^TMP("PSJALL",$J,PSJLN+1,0)="   Adv
            erse Reactions: "_$G(PSGADR(1)),PSJLN=PSJLN+2,X=1
 32 +15    I ($G(PSGVADR(1))'="NKA")&((PSGVADR>0)!(PSGADR>0)) D
 33 +16    .S ^TMP("PSJALL",$J,PSJLN,0)="",^TMP("PSJALL",$J,PSJLN+1,0)="Reacti
            ons - Verified: "_$G(PSGVADR(1)),PSJLN=PSJLN+2,X=1
 34 +17    .F  S X=$O(PSGVADR(X)) Q:'X  S ^TMP("PSJALL",$J,PSJLN,0)="         
                 "_PSGVADR(X),PSJLN=PSJLN+1
 35 +18    .S ^TMP("PSJALL",$J,PSJLN,0)="        Non-Verified: "_$G(PSGADR(1))
            ,PSJLN=PSJLN+2,X=1
 36 +19    .F  S X=$O(PSGADR(X)) Q:'X  S ^TMP("PSJALL",$J,PSJLN,0)="          
                "_PSGADR(X),PSJLN=PSJLN+1
 37 +20    ;

NARRATIV^PSJLMUTL

NARRATIV^PSJLMUTL CODE

 38 NARRATIV --
            ; print inpatient/outpatient narratives
 39 +1     N PSJCLHD
 40 +2     S ^TMP("PSJALL",$J,PSJLN,0)="" D SETNAR("PSJALL",$G(^PS(55,DFN,5.3)
            ),"In")
 41 +3     S ^TMP("PSJALL",$J,PSJLN+1,0)="" D SETNAR("PSJALL",$G(^PS(55,DFN,1)
            ),"Out")
 42 +4     D SDA S PSJLN=0 F X=0:0 S X=$O(^TMP("PSJALL",$J,X)) Q:'X  S PSJLN=P
            SJLN+1
 43 +5     I '$G(PSJCLHD)!'$G(VALMCNT) S VALMCNT=PSJLN
 44 +6     Q
 45 +7     ;

SDA^PSJLMUTL

SDA^PSJLMUTL CODE

 46 SDA    N PSJPAD,PSJCLIN,PSJCLINO,PSJAPD,PSJSCI,PSJCLOK,VAERR K ^TMP("PSJVS
            IT"),PSJDBUN S $P(PSJPAD," ",26)=" "
 47 +1     Q:'$$PATCH^XPDUTL("SD*5.3*285")
 48 +2     D NOW^%DTC S VASD("F")=$P(%,".")-1
 49 +3     D SDA^VADPT S:$G(VAERR)=2 (PSJCLHD,PSJDBUN)=2 I $O(^UTILITY("VASD",
            $J,"")) M PSJUTL=^UTILITY("VASD",$J) D
 50 +4     . S PSJSCDT0=0
 51 +5     . F  S PSJSCDT0=$O(PSJUTL(PSJSCDT0)) Q:'PSJSCDT0  D
 52 +6     .. S PSJCLINO=$P($G(PSJUTL(PSJSCDT0,"E")),U,2),PSJCLIN=$P($G(PSJUTL
            (PSJSCDT0,"I")),U,2)
 53 +7     .. S PSJSCI=$G(PSJUTL(PSJSCDT0,"I")),PSJAPD=$$FMTE^XLFDT(+PSJSCI) Q
            :(PSJCLIN="")!(PSJAPD="")
 54 +8     .. S PSJCLOK=1 D SDAUTHCL^SDAMA203(PSJCLIN,.PSJCLOK) Q:(PSJCLOK<1)
 55 +9     .. S ^TMP("PSJVSIT",$J,+PSJSCI,PSJCLIN,"V")=$E(PSJCLINO_PSJPAD,1,25
            )_"  "_$TR(PSJAPD,"@","/"),PSJCLHD=1
 56 +10    .. D ENC(DFN,PSJCLIN)
 57 +11    I $G(PSJCLHD) S PSJLN=PSJLN+1 S ^TMP("PSJALL",$J,PSJLN,0)="Clinic:"
            _$E(PSJPAD,1,20)_"Date/Time of Appointment:",PSJLN=PSJLN+1 I $G(PS
            JCLHD)=2 D
 58 +12    . S ^TMP("PSJALL",$J,PSJLN,0)=" Scheduling database is unavailable"
            ,PSJLN=PSJLN+1
 59 +13    N VDAT S VDAT=0 F  S VDAT=$O(^TMP("PSJVSIT",$J,VDAT)) Q:'VDAT  S VC
            LIN=0 F  S VCLIN=$O(^TMP("PSJVSIT",$J,VDAT,VCLIN)) Q:'VCLIN  D
 60 +14    . F VTYP="E","V" S VDATA=$G(^TMP("PSJVSIT",$J,VDAT,VCLIN,VTYP)) I V
            DATA]"" S ^TMP("PSJALL",$J,PSJLN,0)=VDATA,PSJLN=PSJLN+1
 61 +15    I $G(PSJCLHD) S VALMCNT=((PSJLN+11\11)*11),PSJX=$O(^TMP("PSJALL",$J
            ,9999),-1) ; F I=PSJX:1:VALMCNT S ^TMP("PSJALL",$J,I,0)=""
 62 +16    K PSJUTL,PSJCLHD
 63 +17    Q
 64 +18    ;

ENC(SDPATDFN,SDCLIEN)^PSJLMUTL

ENC(SDPATDFN,SDCLIEN)^PSJLMUTL CODE

 65 ENC(SDPATDFN,SDCLIEN) --
            ;
 66 +1     N SDFROM,DT,SUBVIS,VIS S SDSTART=$$FMADD^XLFDT($P(PSGDT,"."),-1),SD
            END=$$FMADD^XLFDT($P(PSGDT,"."),+365) K ^TMP("VSIT",$J)
 67 +2     D SELECTED^VSIT(SDPATDFN,SDSTART,SDEND,SDCLIEN) N VIS S VIS=0 F  S 
            VIS=$O(^TMP("VSIT",$J,VIS)) Q:'VIS  D
 68 +3     . S SUBVIS=0 F  S SUBVIS=$O(^TMP("VSIT",$J,VIS,SUBVIS)) Q:'SUBVIS  
            D
 69 +4     .. S PSJSCI=$P(^TMP("VSIT",$J,VIS,SUBVIS),U),PSJAPD=$$FMTE^XLFDT(PS
            JSCI,1) Q:PSJSCI<1!(PSJAPD="")
 70 +5     .. S ^TMP("PSJVSIT",$J,PSJSCI,PSJCLIN,"E")=$E(PSJCLINO_PSJPAD,1,25)
            _"  "_$TR(PSJAPD,"@","/")_" *Encounter",PSJCLHD=1
 71 +6     Q
 72 +7     ;

SETNAR(SUB,NARR,TYPE)^PSJLMUTL

SETNAR(SUB,NARR,TYPE)^PSJLMUTL CODE

 73 SETNAR(SUB,NARR,TYPE) --
            ; Set up Narrative info.
 74 +1     S NARR=TYPE_"patient Narrative: "_NARR,Y="" S:TYPE="In" NARR=" "_NA
            RR
 75 +2     S START=1 F  D  Q:NARR=""
 76 +3     .I $L($P(NARR," "))>79 S PSJ=$E(NARR,START,START+79),NARR=$E(NARR,S
            TART+80,$L(NARR)) Q
 77 +4     .I $L(NARR)>79 S PSJ=$P(NARR," ",1,$L($E(NARR,1,80)," ")-1),NARR=$E
            ($P(NARR,PSJ,2),2,$L(NARR)) D SET Q
 78 +5     .S PSJ=NARR,NARR="" D SET
 79 +6     Q
 80 +7     ;

SET^PSJLMUTL

SET^PSJLMUTL CODE

 81 SET    ; Set ^TMP for narratives.
 82 +1     S ^TMP(SUB,$J,PSJLN,0)=PSJ,PSJLN=PSJLN+1
 83 +2     Q
 84 +3     ;

ACTIONS()^PSJLMUTL

ACTIONS()^PSJLMUTL CODE

 85 ACTIONS() --
            ;
 86 +1     N DIC,X,Y
 87 +2     S Y=$P($G(^ORD(101,+$G(^ORD(101,DA(1),10,DA,0)),0)),U) I Y="" Q 0
 88 +3     I Y="PSJ LM DC" Q $S(PSGACT["D":1,1:0)
 89 +4     I Y="PSJU LM EDIT" Q $S(PSGACT["E":1,1:0)
 90 +5     I Y="PSJU LM RENEW" Q $S(PSGACT["R":1,1:0)
 91 +6     I Y="PSJ LM HOLD" Q $S(PSGACT["H":1,1:0)
 92 +7     I Y="PSJU LM VERIFY" Q $S(PSGACT["V":1,1:0)
 93 +8     I Y="PSJ LM EDIT NEW" Q $S(PSGACT["E":1,1:0)
 94 +9     I Y="PSJ LM FLAG" Q $S(PSGACT["G":1,1:0)
 95 +10    Q 1

RNACT()^PSJLMUTL

RNACT()^PSJLMUTL CODE

 96 RNACT() ;
 97 +1     I '$G(PSJRNF),'$G(PSJIRNF) Q 0
 98 +2     NEW X S X=$G(^PS(53.1,+PSJORD,0))
 99 +3     S PSGACT=""
100 +4     I $S(+$P(X,U,13):1,$G(PSJRNF)&($P(X,U,4)="U"):1,$G(PSJIRNF)&($P(X,U
            ,4)'="U"):1,1:0) S PSGACT="BFDE"
101 +5     NEW X,Y
102 +6     S Y=$P($G(^ORD(101,+$G(^ORD(101,DA(1),10,DA,0)),0)),U) I Y="" Q 0
103 +7     I Y="PSJ LM DC" Q $S(PSGACT["D":1,1:0)
104 +8     I Y="PSJ LM BYPASS" Q $S(PSGACT["B":1,1:0)
105 +9     I Y="PSJ LM FINISH" Q $S(PSGACT["F":1,1:0)
106 +10    I Y="PSJI LM DISCONTINUE" Q $S(PSGACT["D":1,1:0)
107 +11    I Y="PSJI LM EDIT" Q $S(PSGACT["E":1,1:0)
108 +12    I Y="PSJI LM FINISH" Q $S(PSGACT["F":1,1:0)
109 +13    I Y="PSJ LM FLAG" Q 0
110 +14    Q 1
111 +15    ;

TECHACT()^PSJLMUTL

TECHACT()^PSJLMUTL CODE

112 TECHACT() --
            ; Allowable actions for IV technician (PSJI PHARM TECH)
113 +1     Q:'$G(PSJITECH) 0
114 +2     NEW X S X=$G(^PS(53.1,+PSJORD,0))
115 +3     I $S(+$P(X,U,13):1,$P(X,U,4)'="U":1,1:0) S PSGACT="F"
116 +4     N DIC,X,Y
117 +5     S Y=$P($G(^ORD(101,+$G(^ORD(101,DA(1),10,DA,0)),0)),U) I Y="" Q 0
118 +6     I Y="PSJ LM DC" Q $S(PSGACT["D":1,1:0)
119 +7     I Y="PSJ LM BYPASS" Q $S(PSGACT["B":1,1:0)
120 +8     I Y="PSJ LM FINISH" Q $S(PSGACT["F":1,1:0)
121 +9     I Y="PSJI LM DISCONTINUE" Q $S(PSGACT["D":1,1:0)
122 +10    I Y="PSJI LM EDIT" Q $S(PSGACT["E":1,1:0)
123 +11    I Y="PSJI LM FINISH" Q $S(PSGACT["F":1,1:0)
124 +12    I Y="PSJ LM FLAG" Q 0
125 +13    Q 1

PATINFO()^PSJLMUTL

PATINFO()^PSJLMUTL CODE

126 PATINFO() --
                    ; Determines if detailed allergy info can be displayed.
127 +1     S Y=$P($G(^ORD(101,+$G(^ORD(101,DA(1),10,DA,0)),0)),U) I Y="" Q 0
128 +2     I Y="PSJ LM SHOW PROFILE",$D(PSJLMPRO) Q 0
129 +3     Q 1

HIDDEN(CHK)^PSJLMUTL

HIDDEN(CHK)^PSJLMUTL CODE

130 HIDDEN(CHK) --
            ; Determines if certain Hidden actions are to be available.
131 +1     I CHK="JUMP",'$G(PSJPNV) D NA("Jump is only available through Non-V
            erified/Pending Orders option.") Q 0
132 +2     I CHK="SPEED",'$D(PSJUDPRF) D NA("Speed options are only available 
            from the Unit Dose Order Entry Profile.") Q 0
133 +3     ;PSJ*5*198;GMZ;Remove copy function from this option
134 +4     I CHK="COPY",('$D(PSGACT)!($G(PSGACT)="")) D NA("Copy is not allowe
            d from this option.") Q 0
135 +5     Q 1
136 +6     ;

NA(TXT)^PSJLMUTL

NA(TXT)^PSJLMUTL CODE

137 NA(TXT) ;
138 +1     D FULL^VALM1 W !!,TXT,!! N DIR S DIR(0)="E" D ^DIR
139 +2     Q
140 +3     ;

UPR(DFN)^PSJLMUTL

UPR(DFN)^PSJLMUTL CODE

141 UPR(DFN) --
                    ; UPDATE PATIENT SPECIFIC DATA IN 55
142 +1     N DIE,DR S PSJC10=VALMCNT
143 +2     S DA=DFN,DIE="^PS(55,",DR="62.2;62.01" D ^DIE,DISALL^PSJLMUTL(DFN)
144 +3     S VALMCNT=PSJC10 K PSJC10
145 +4     Q
146 +5     ;

DETALL(DFN)^PSJLMUTL

DETALL(DFN)^PSJLMUTL CODE

147 DETALL(DFN) --
                   ; Enter Detailed Allergy Display list.
148 +1     D EN^VALM("PSJ LM ALLERGY DISPLAY")
149 +2     Q

BRFALL(DFN)^PSJLMUTL

BRFALL(DFN)^PSJLMUTL CODE

150 BRFALL(DFN) --
                   ;
151 +1     D EN^VALM("PSJ LM BRIEF PATIENT INFO")
152 +2     Q

PAUSE^PSJLMUTL

PAUSE^PSJLMUTL CODE

153 PAUSE  ;
154 +1     N DIR S DIR(0)="E" D ^DIR
155 +2     Q

DRUGNAME(DFN,ON)^PSJLMUTL

DRUGNAME(DFN,ON)^PSJLMUTL CODE

156 DRUGNAME(DFN,ON) --
            ; Find drug name to display
157 +1     ;If order is in 55:
158 +2     ;.If Dosage Ordered is found, returns OI_U_Dosage Ordered.
159 +3     ;.If no Dosage Ordered, returns Dispense Drug only.
160 +4     ;If order in 53.1:
161 +5     ;.If Dosage Ordered, returns OI_U_Dosage Ordered.
162 +6     ;.If Dispense Drug is found, returns Dispense Drug name_U_Instructi
            ons.
163 +7     ;.If no dispense drug, returns OI_U_Instructions.
164 +8     I ON["U" D  Q DN
165 +9     .S OIND=$G(^PS(55,DFN,5,+ON,.2))
166 +10    .I $P(OIND,U,2)]"",($G(^PS(50.7,+OIND,0))]"") S DN=$$OINAME(OIND)_U
            _.2 Q
167 +11    .S X=+$O(^PS(55,DFN,5,+ON,1,0)),X=$G(^PS(55,DFN,5,+ON,1,X,0)) I $P(
            X,U)]"" S DN=$$DDNAME(+X)_"^^"_$P(X,"^",2) Q  ;$S($P(OIND,U,2)]"":
            .2,1:.3) Q
168 +12    .S DN=$$OINAME(+OIND)_U_.3 Q
169 +13    S OIND=$G(^PS(53.1,+ON,.2)) Q:$P(OIND,U,2)]"" $$OINAME(OIND)_U_.2
170 +14    S X=+$O(^PS(53.1,+ON,1,0)) I X,'$O(^PS(53.1,+ON,1,X)) S X=$G(^PS(53
            .1,+ON,1,X,0)) I $P(X,U)]"" Q $$DDNAME(+X)_U_.3_$P(X,"^",2)
171 +15    Q $$OINAME(OIND)_U_.3
172 +16    ;

DDNAME(X)^PSJLMUTL

DDNAME(X)^PSJLMUTL CODE

173 DDNAME(X) --
            ; 
174 +1     Q $$FOUND($P($G(^PSDRUG(+X,0)),U),X,"PSDRUG(,")
175 +2     ;

OINAME(ND)^PSJLMUTL

OINAME(ND)^PSJLMUTL CODE

176 OINAME(ND) --
            ; Return Orderable Item Name_" "_Dose Form_U_Dosage Ordered
177 +1     N DF,DNME,X
178 +2     S X=$G(^PS(50.7,+ND,0)),DNME="" S:X]"" DF=$P($G(^PS(50.606,+$P(X,U,
            2),0)),U),DNME=$P(X,U)_" "_DF
179 +3     Q $$FOUND(DNME,+ND,"PS(50.7")
180 +4     ;

FOUND(DNME,DN,FN)^PSJLMUTL

FOUND(DNME,DN,FN)^PSJLMUTL CODE

181 FOUND(DNME,DN,FN) --
            ;
182 +1     Q $S(DNME]"":DNME,1:"NOT FOUND "_DN_";"_FN)