PSJLMUTL ;BIR/MLM - INPATIENT LISTMAN UTILITIES ; 9/12/07 10:28am
;;5.0;INPATIENT MEDICATIONS ;**7,67,58,85,111,160,198,320,281**;16 DEC 97;Build 113
;
; Reference to ^ORD(101 is supported by DBIA #872.
; Reference to ^PS(50.606 is supported by DBIA #2174.
; Reference to ^PS(50.7 is supported by DBIA #2180.
; Reference to ^PS(55 is supported by DBIA #2191.
; Reference to ^PSDRUG( is supported by DBIA #2192.
; Reference to ^GMRAPEM0 is supported by DBIA #190.
; Reference to ^SDAMA203 is supported by DBIA #4133.
; Reference to SELECTED^VSIT is supported by DBIA #1905.
;
NEWALL(DFN) ; Enter Allergy info.
;
D FULL^VALM1,EN2^GMRAPEM0
Q
DISALL(DFN) ; Display brief patient info list.
K ^TMP("PSJALL",$J) N PSJLN,X,Y,PSGALG,PSGRALG,PSGLDR,PSJGMRAL,PSJWHERE S PSJWHERE="PSJLMUTL"
D ATS^PSJMUTL(57,57,2)
I (PSJGMRAL=0) S ^TMP("PSJALL",$J,1,0)=" Allergies/Reactions: "_"NKA",PSJLN=2 G RAD
I (PSJGMRAL="") S ^TMP("PSJALL",$J,1,0)=" Allergies/Reactions: No Allergy Assessment",PSJLN=2 G RAD
I ($G(PSGVALG(1))="NKA")!((PSGVALG=0)&(PSGALG=0)) D
.S ^TMP("PSJALL",$J,1,0)=" Allergies: "_$G(PSGVALG(1)),PSJLN=2,X=1
I ($G(PSGVALG(1))'="NKA")&((PSGVALG>0)!(PSGALG>0)) D
.S ^TMP("PSJALL",$J,1,0)="Allergies - Verified: "_$G(PSGVALG(1)),PSJLN=2,X=1
.F S X=$O(PSGVALG(X)) Q:'X S ^TMP("PSJALL",$J,PSJLN,0)=" "_PSGVALG(X),PSJLN=PSJLN+1
.S ^TMP("PSJALL",$J,PSJLN,0)=" Non-Verified: "_$S($G(PSGALG(1))=0:"",1:$G(PSGALG(1))),PSJLN=PSJLN+1,X=1
.F S X=$O(PSGALG(X)) Q:'X S ^TMP("PSJALL",$J,PSJLN,0)=" "_PSGALG(X),PSJLN=PSJLN+1
RAD D RAD^PSJMUTL
I ($G(PSGVADR(1))="NKA")!((PSGVADR=0)&(PSGADR=0)) D
.S ^TMP("PSJALL",$J,PSJLN,0)="",^TMP("PSJALL",$J,PSJLN+1,0)=" Adverse Reactions: "_$G(PSGADR(1)),PSJLN=PSJLN+2,X=1
I ($G(PSGVADR(1))'="NKA")&((PSGVADR>0)!(PSGADR>0)) D
.S ^TMP("PSJALL",$J,PSJLN,0)="",^TMP("PSJALL",$J,PSJLN+1,0)="Reactions - Verified: "_$G(PSGVADR(1)),PSJLN=PSJLN+2,X=1
.F S X=$O(PSGVADR(X)) Q:'X S ^TMP("PSJALL",$J,PSJLN,0)=" "_PSGVADR(X),PSJLN=PSJLN+1
.S ^TMP("PSJALL",$J,PSJLN,0)=" Non-Verified: "_$G(PSGADR(1)),PSJLN=PSJLN+2,X=1
.F S X=$O(PSGADR(X)) Q:'X S ^TMP("PSJALL",$J,PSJLN,0)=" "_PSGADR(X),PSJLN=PSJLN+1
;
NARRATIV ; print inpatient/outpatient narratives
N PSJCLHD
S ^TMP("PSJALL",$J,PSJLN,0)="" D SETNAR("PSJALL",$G(^PS(55,DFN,5.3)),"In")
S ^TMP("PSJALL",$J,PSJLN+1,0)="" D SETNAR("PSJALL",$G(^PS(55,DFN,1)),"Out")
D SDA S PSJLN=0 F X=0:0 S X=$O(^TMP("PSJALL",$J,X)) Q:'X S PSJLN=PSJLN+1
I '$G(PSJCLHD)!'$G(VALMCNT) S VALMCNT=PSJLN
Q
;
SDA N PSJPAD,PSJCLIN,PSJCLINO,PSJAPD,PSJSCI,PSJCLOK,VAERR K ^TMP("PSJVSIT"),PSJDBUN S $P(PSJPAD," ",26)=" "
Q:'$$PATCH^XPDUTL("SD*5.3*285")
D NOW^%DTC S VASD("F")=$P(%,".")-1
D SDA^VADPT S:$G(VAERR)=2 (PSJCLHD,PSJDBUN)=2 I $O(^UTILITY("VASD",$J,"")) M PSJUTL=^UTILITY("VASD",$J) D
. S PSJSCDT0=0
. F S PSJSCDT0=$O(PSJUTL(PSJSCDT0)) Q:'PSJSCDT0 D
.. S PSJCLINO=$P($G(PSJUTL(PSJSCDT0,"E")),U,2),PSJCLIN=$P($G(PSJUTL(PSJSCDT0,"I")),U,2)
.. S PSJSCI=$G(PSJUTL(PSJSCDT0,"I")),PSJAPD=$$FMTE^XLFDT(+PSJSCI) Q:(PSJCLIN="")!(PSJAPD="")
.. S PSJCLOK=1 D SDAUTHCL^SDAMA203(PSJCLIN,.PSJCLOK) Q:(PSJCLOK<1)
.. S ^TMP("PSJVSIT",$J,+PSJSCI,PSJCLIN,"V")=$E(PSJCLINO_PSJPAD,1,25)_" "_$TR(PSJAPD,"@","/"),PSJCLHD=1
.. D ENC(DFN,PSJCLIN)
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(PSJCLHD)=2 D
. S ^TMP("PSJALL",$J,PSJLN,0)=" Scheduling database is unavailable",PSJLN=PSJLN+1
N VDAT S VDAT=0 F S VDAT=$O(^TMP("PSJVSIT",$J,VDAT)) Q:'VDAT S VCLIN=0 F S VCLIN=$O(^TMP("PSJVSIT",$J,VDAT,VCLIN)) Q:'VCLIN D
. F VTYP="E","V" S VDATA=$G(^TMP("PSJVSIT",$J,VDAT,VCLIN,VTYP)) I VDATA]"" S ^TMP("PSJALL",$J,PSJLN,0)=VDATA,PSJLN=PSJLN+1
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)=""
K PSJUTL,PSJCLHD
Q
;
ENC(SDPATDFN,SDCLIEN) ;
I '$G(PSGDT) D NOW^%DTC S PSGDT=% ;*281
N SDFROM,DT,SUBVIS,VIS S SDSTART=$$FMADD^XLFDT($P(PSGDT,"."),-1),SDEND=$$FMADD^XLFDT($P(PSGDT,"."),+365) K ^TMP("VSIT",$J)
D SELECTED^VSIT(SDPATDFN,SDSTART,SDEND,SDCLIEN) N VIS S VIS=0 F S VIS=$O(^TMP("VSIT",$J,VIS)) Q:'VIS D
. S SUBVIS=0 F S SUBVIS=$O(^TMP("VSIT",$J,VIS,SUBVIS)) Q:'SUBVIS D
.. S PSJSCI=$P(^TMP("VSIT",$J,VIS,SUBVIS),U),PSJAPD=$$FMTE^XLFDT(PSJSCI,1) Q:PSJSCI<1!(PSJAPD="")
.. S ^TMP("PSJVSIT",$J,PSJSCI,PSJCLIN,"E")=$E(PSJCLINO_PSJPAD,1,25)_" "_$TR(PSJAPD,"@","/")_" *Encounter",PSJCLHD=1
Q
;
SETNAR(SUB,NARR,TYPE) ; Set up Narrative info.
S NARR=TYPE_"patient Narrative: "_NARR,Y="" S:TYPE="In" NARR=" "_NARR
S START=1 F D Q:NARR=""
.I $L($P(NARR," "))>79 S PSJ=$E(NARR,START,START+79),NARR=$E(NARR,START+80,$L(NARR)) Q
.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
.S PSJ=NARR,NARR="" D SET
Q
;
SET ; Set ^TMP for narratives.
S ^TMP(SUB,$J,PSJLN,0)=PSJ,PSJLN=PSJLN+1
Q
;
ACTIONS() ;
N DIC,X,Y
S Y=$P($G(^ORD(101,+$G(^ORD(101,DA(1),10,DA,0)),0)),U) I Y="" Q 0
I Y="PSJ LM DC" Q $S(PSGACT["D":1,1:0)
I Y="PSJU LM EDIT" Q $S(PSGACT["E":1,1:0)
I Y="PSJU LM RENEW" Q $S(PSGACT["R":1,1:0)
I Y="PSJ LM HOLD" Q $S(PSGACT["H":1,1:0)
I Y="PSJU LM VERIFY" Q $S(PSGACT["V":1,1:0)
I Y="PSJ LM EDIT NEW" Q $S(PSGACT["E":1,1:0)
I Y="PSJ LM FLAG" Q $S(PSGACT["G":1,1:0)
Q 1
RNACT() ;
I '$G(PSJRNF),'$G(PSJIRNF) Q 0
NEW X S X=$G(^PS(53.1,+PSJORD,0))
S PSGACT=""
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"
NEW X,Y
S Y=$P($G(^ORD(101,+$G(^ORD(101,DA(1),10,DA,0)),0)),U) I Y="" Q 0
I Y="PSJ LM DC" Q $S(PSGACT["D":1,1:0)
I Y="PSJ LM BYPASS" Q $S(PSGACT["B":1,1:0)
I Y="PSJ LM FINISH" Q $S(PSGACT["F":1,1:0)
I Y="PSJI LM DISCONTINUE" Q $S(PSGACT["D":1,1:0)
I Y="PSJI LM EDIT" Q $S(PSGACT["E":1,1:0)
I Y="PSJI LM FINISH" Q $S(PSGACT["F":1,1:0)
I Y="PSJ LM FLAG" Q 0
Q 1
;
TECHACT() ; Allowable actions for IV technician (PSJI PHARM TECH)
Q:'$G(PSJITECH) 0
NEW X S X=$G(^PS(53.1,+PSJORD,0))
I $S(+$P(X,U,13):1,$P(X,U,4)'="U":1,1:0) S PSGACT="F"
N DIC,X,Y
S Y=$P($G(^ORD(101,+$G(^ORD(101,DA(1),10,DA,0)),0)),U) I Y="" Q 0
I Y="PSJ LM DC" Q $S(PSGACT["D":1,1:0)
I Y="PSJ LM BYPASS" Q $S(PSGACT["B":1,1:0)
I Y="PSJ LM FINISH" Q $S(PSGACT["F":1,1:0)
I Y="PSJI LM DISCONTINUE" Q $S(PSGACT["D":1,1:0)
I Y="PSJI LM EDIT" Q $S(PSGACT["E":1,1:0)
I Y="PSJI LM FINISH" Q $S(PSGACT["F":1,1:0)
I Y="PSJ LM FLAG" Q 0
Q 1
PATINFO() ; Determines if detailed allergy info can be displayed.
S Y=$P($G(^ORD(101,+$G(^ORD(101,DA(1),10,DA,0)),0)),U) I Y="" Q 0
I Y="PSJ LM SHOW PROFILE",$D(PSJLMPRO) Q 0
Q 1
HIDDEN(CHK) ; Determines if certain Hidden actions are to be available.
I CHK="JUMP",'$G(PSJPNV) D NA("Jump is only available through Non-Verified/Pending Orders option.") Q 0
I CHK="SPEED",'$D(PSJUDPRF) D NA("Speed options are only available from the Unit Dose Order Entry Profile.") Q 0
;PSJ*5*198;GMZ;Remove copy function from this option
I CHK="COPY",('$D(PSGACT)!($G(PSGACT)="")) D NA("Copy is not allowed from this option.") Q 0
Q 1
;
NA(TXT) ;
D FULL^VALM1 W !!,TXT,!! N DIR S DIR(0)="E" D ^DIR
Q
;
UPR(DFN) ; UPDATE PATIENT SPECIFIC DATA IN 55
N DIE,DR S PSJC10=VALMCNT
S DA=DFN,DIE="^PS(55,",DR="62.2;62.01" D ^DIE,DISALL^PSJLMUTL(DFN)
S VALMCNT=PSJC10 K PSJC10
Q
;
DETALL(DFN) ; Enter Detailed Allergy Display list.
D EN^VALM("PSJ LM ALLERGY DISPLAY")
Q
BRFALL(DFN) ;
D EN^VALM("PSJ LM BRIEF PATIENT INFO")
Q
PAUSE ;
N DIR S DIR(0)="E" D ^DIR
Q
DRUGNAME(DFN,ON) ; Find drug name to display
;If order is in 55:
;.If Dosage Ordered is found, returns OI_U_Dosage Ordered.
;.If no Dosage Ordered, returns Dispense Drug only.
;If order in 53.1:
;.If Dosage Ordered, returns OI_U_Dosage Ordered.
;.If Dispense Drug is found, returns Dispense Drug name_U_Instructions.
;.If no dispense drug, returns OI_U_Instructions.
I ON["U" D Q DN
.S OIND=$G(^PS(55,DFN,5,+ON,.2))
.I $P(OIND,U,2)]"",($G(^PS(50.7,+OIND,0))]"") S DN=$$OINAME(OIND)_U_.2 Q
.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
.S DN=$$OINAME(+OIND)_U_.3 Q
S OIND=$G(^PS(53.1,+ON,.2)) Q:$P(OIND,U,2)]"" $$OINAME(OIND)_U_.2
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)
Q $$OINAME(OIND)_U_.3
;
DDNAME(X) ;
Q $$FOUND($P($G(^PSDRUG(+X,0)),U),X,"PSDRUG(,")
;
OINAME(ND) ; Return Orderable Item Name_" "_Dose Form_U_Dosage Ordered
N DF,DNME,X
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
Q $$FOUND(DNME,+ND,"PS(50.7")
;
FOUND(DNME,DN,FN) ;
Q $S(DNME]"":DNME,1:"NOT FOUND "_DN_";"_FN)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJLMUTL 9010 printed Dec 13, 2024@02:07:34 Page 2
PSJLMUTL ;BIR/MLM - INPATIENT LISTMAN UTILITIES ; 9/12/07 10:28am
+1 ;;5.0;INPATIENT MEDICATIONS ;**7,67,58,85,111,160,198,320,281**;16 DEC 97;Build 113
+2 ;
+3 ; Reference to ^ORD(101 is supported by DBIA #872.
+4 ; Reference to ^PS(50.606 is supported by DBIA #2174.
+5 ; Reference to ^PS(50.7 is supported by DBIA #2180.
+6 ; Reference to ^PS(55 is supported by DBIA #2191.
+7 ; Reference to ^PSDRUG( is supported by DBIA #2192.
+8 ; Reference to ^GMRAPEM0 is supported by DBIA #190.
+9 ; Reference to ^SDAMA203 is supported by DBIA #4133.
+10 ; Reference to SELECTED^VSIT is supported by DBIA #1905.
+11 ;
NEWALL(DFN) ; Enter Allergy info.
+1 ;
+2 DO FULL^VALM1
DO EN2^GMRAPEM0
+3 QUIT
DISALL(DFN) ; Display brief patient info list.
+1 KILL ^TMP("PSJALL",$JOB)
NEW PSJLN,X,Y,PSGALG,PSGRALG,PSGLDR,PSJGMRAL,PSJWHERE
SET PSJWHERE="PSJLMUTL"
+2 DO ATS^PSJMUTL(57,57,2)
+3 IF (PSJGMRAL=0)
SET ^TMP("PSJALL",$JOB,1,0)=" Allergies/Reactions: "_"NKA"
SET PSJLN=2
GOTO RAD
+4 IF (PSJGMRAL="")
SET ^TMP("PSJALL",$JOB,1,0)=" Allergies/Reactions: No Allergy Assessment"
SET PSJLN=2
GOTO RAD
+5 IF ($GET(PSGVALG(1))="NKA")!((PSGVALG=0)&(PSGALG=0))
Begin DoDot:1
+6 SET ^TMP("PSJALL",$JOB,1,0)=" Allergies: "_$GET(PSGVALG(1))
SET PSJLN=2
SET X=1
End DoDot:1
+7 IF ($GET(PSGVALG(1))'="NKA")&((PSGVALG>0)!(PSGALG>0))
Begin DoDot:1
+8 SET ^TMP("PSJALL",$JOB,1,0)="Allergies - Verified: "_$GET(PSGVALG(1))
SET PSJLN=2
SET X=1
+9 FOR
SET X=$ORDER(PSGVALG(X))
if 'X
QUIT
SET ^TMP("PSJALL",$JOB,PSJLN,0)=" "_PSGVALG(X)
SET PSJLN=PSJLN+1
+10 SET ^TMP("PSJALL",$JOB,PSJLN,0)=" Non-Verified: "_$SELECT($GET(PSGALG(1))=0:"",1:$GET(PSGALG(1)))
SET PSJLN=PSJLN+1
SET X=1
+11 FOR
SET X=$ORDER(PSGALG(X))
if 'X
QUIT
SET ^TMP("PSJALL",$JOB,PSJLN,0)=" "_PSGALG(X)
SET PSJLN=PSJLN+1
End DoDot:1
RAD DO RAD^PSJMUTL
+1 IF ($GET(PSGVADR(1))="NKA")!((PSGVADR=0)&(PSGADR=0))
Begin DoDot:1
+2 SET ^TMP("PSJALL",$JOB,PSJLN,0)=""
SET ^TMP("PSJALL",$JOB,PSJLN+1,0)=" Adverse Reactions: "_$GET(PSGADR(1))
SET PSJLN=PSJLN+2
SET X=1
End DoDot:1
+3 IF ($GET(PSGVADR(1))'="NKA")&((PSGVADR>0)!(PSGADR>0))
Begin DoDot:1
+4 SET ^TMP("PSJALL",$JOB,PSJLN,0)=""
SET ^TMP("PSJALL",$JOB,PSJLN+1,0)="Reactions - Verified: "_$GET(PSGVADR(1))
SET PSJLN=PSJLN+2
SET X=1
+5 FOR
SET X=$ORDER(PSGVADR(X))
if 'X
QUIT
SET ^TMP("PSJALL",$JOB,PSJLN,0)=" "_PSGVADR(X)
SET PSJLN=PSJLN+1
+6 SET ^TMP("PSJALL",$JOB,PSJLN,0)=" Non-Verified: "_$GET(PSGADR(1))
SET PSJLN=PSJLN+2
SET X=1
+7 FOR
SET X=$ORDER(PSGADR(X))
if 'X
QUIT
SET ^TMP("PSJALL",$JOB,PSJLN,0)=" "_PSGADR(X)
SET PSJLN=PSJLN+1
End DoDot:1
+8 ;
NARRATIV ; print inpatient/outpatient narratives
+1 NEW PSJCLHD
+2 SET ^TMP("PSJALL",$JOB,PSJLN,0)=""
DO SETNAR("PSJALL",$GET(^PS(55,DFN,5.3)),"In")
+3 SET ^TMP("PSJALL",$JOB,PSJLN+1,0)=""
DO SETNAR("PSJALL",$GET(^PS(55,DFN,1)),"Out")
+4 DO SDA
SET PSJLN=0
FOR X=0:0
SET X=$ORDER(^TMP("PSJALL",$JOB,X))
if 'X
QUIT
SET PSJLN=PSJLN+1
+5 IF '$GET(PSJCLHD)!'$GET(VALMCNT)
SET VALMCNT=PSJLN
+6 QUIT
+7 ;
SDA NEW PSJPAD,PSJCLIN,PSJCLINO,PSJAPD,PSJSCI,PSJCLOK,VAERR
KILL ^TMP("PSJVSIT"),PSJDBUN
SET $PIECE(PSJPAD," ",26)=" "
+1 if '$$PATCH^XPDUTL("SD*5.3*285")
QUIT
+2 DO NOW^%DTC
SET VASD("F")=$PIECE(%,".")-1
+3 DO SDA^VADPT
if $GET(VAERR)=2
SET (PSJCLHD,PSJDBUN)=2
IF $ORDER(^UTILITY("VASD",$JOB,""))
MERGE PSJUTL=^UTILITY("VASD",$JOB)
Begin DoDot:1
+4 SET PSJSCDT0=0
+5 FOR
SET PSJSCDT0=$ORDER(PSJUTL(PSJSCDT0))
if 'PSJSCDT0
QUIT
Begin DoDot:2
+6 SET PSJCLINO=$PIECE($GET(PSJUTL(PSJSCDT0,"E")),U,2)
SET PSJCLIN=$PIECE($GET(PSJUTL(PSJSCDT0,"I")),U,2)
+7 SET PSJSCI=$GET(PSJUTL(PSJSCDT0,"I"))
SET PSJAPD=$$FMTE^XLFDT(+PSJSCI)
if (PSJCLIN="")!(PSJAPD="")
QUIT
+8 SET PSJCLOK=1
DO SDAUTHCL^SDAMA203(PSJCLIN,.PSJCLOK)
if (PSJCLOK<1)
QUIT
+9 SET ^TMP("PSJVSIT",$JOB,+PSJSCI,PSJCLIN,"V")=$EXTRACT(PSJCLINO_PSJPAD,1,25)_" "_$TRANSLATE(PSJAPD,"@","/")
SET PSJCLHD=1
+10 DO ENC(DFN,PSJCLIN)
End DoDot:2
End DoDot:1
+11 IF $GET(PSJCLHD)
SET PSJLN=PSJLN+1
SET ^TMP("PSJALL",$JOB,PSJLN,0)="Clinic:"_$EXTRACT(PSJPAD,1,20)_"Date/Time of Appointment:"
SET PSJLN=PSJLN+1
IF $GET(PSJCLHD)=2
Begin DoDot:1
+12 SET ^TMP("PSJALL",$JOB,PSJLN,0)=" Scheduling database is unavailable"
SET PSJLN=PSJLN+1
End DoDot:1
+13 NEW VDAT
SET VDAT=0
FOR
SET VDAT=$ORDER(^TMP("PSJVSIT",$JOB,VDAT))
if 'VDAT
QUIT
SET VCLIN=0
FOR
SET VCLIN=$ORDER(^TMP("PSJVSIT",$JOB,VDAT,VCLIN))
if 'VCLIN
QUIT
Begin DoDot:1
+14 FOR VTYP="E","V"
SET VDATA=$GET(^TMP("PSJVSIT",$JOB,VDAT,VCLIN,VTYP))
IF VDATA]""
SET ^TMP("PSJALL",$JOB,PSJLN,0)=VDATA
SET PSJLN=PSJLN+1
End DoDot:1
+15 ; F I=PSJX:1:VALMCNT S ^TMP("PSJALL",$J,I,0)=""
IF $GET(PSJCLHD)
SET VALMCNT=((PSJLN+11\11)*11)
SET PSJX=$ORDER(^TMP("PSJALL",$JOB,9999),-1)
+16 KILL PSJUTL,PSJCLHD
+17 QUIT
+18 ;
ENC(SDPATDFN,SDCLIEN) ;
+1 ;*281
IF '$GET(PSGDT)
DO NOW^%DTC
SET PSGDT=%
+2 NEW SDFROM,DT,SUBVIS,VIS
SET SDSTART=$$FMADD^XLFDT($PIECE(PSGDT,"."),-1)
SET SDEND=$$FMADD^XLFDT($PIECE(PSGDT,"."),+365)
KILL ^TMP("VSIT",$JOB)
+3 DO SELECTED^VSIT(SDPATDFN,SDSTART,SDEND,SDCLIEN)
NEW VIS
SET VIS=0
FOR
SET VIS=$ORDER(^TMP("VSIT",$JOB,VIS))
if 'VIS
QUIT
Begin DoDot:1
+4 SET SUBVIS=0
FOR
SET SUBVIS=$ORDER(^TMP("VSIT",$JOB,VIS,SUBVIS))
if 'SUBVIS
QUIT
Begin DoDot:2
+5 SET PSJSCI=$PIECE(^TMP("VSIT",$JOB,VIS,SUBVIS),U)
SET PSJAPD=$$FMTE^XLFDT(PSJSCI,1)
if PSJSCI<1!(PSJAPD="")
QUIT
+6 SET ^TMP("PSJVSIT",$JOB,PSJSCI,PSJCLIN,"E")=$EXTRACT(PSJCLINO_PSJPAD,1,25)_" "_$TRANSLATE(PSJAPD,"@","/")_" *Encounter"
SET PSJCLHD=1
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
SETNAR(SUB,NARR,TYPE) ; Set up Narrative info.
+1 SET NARR=TYPE_"patient Narrative: "_NARR
SET Y=""
if TYPE="In"
SET NARR=" "_NARR
+2 SET START=1
FOR
Begin DoDot:1
+3 IF $LENGTH($PIECE(NARR," "))>79
SET PSJ=$EXTRACT(NARR,START,START+79)
SET NARR=$EXTRACT(NARR,START+80,$LENGTH(NARR))
QUIT
+4 IF $LENGTH(NARR)>79
SET PSJ=$PIECE(NARR," ",1,$LENGTH($EXTRACT(NARR,1,80)," ")-1)
SET NARR=$EXTRACT($PIECE(NARR,PSJ,2),2,$LENGTH(NARR))
DO SET
QUIT
+5 SET PSJ=NARR
SET NARR=""
DO SET
End DoDot:1
if NARR=""
QUIT
+6 QUIT
+7 ;
SET ; Set ^TMP for narratives.
+1 SET ^TMP(SUB,$JOB,PSJLN,0)=PSJ
SET PSJLN=PSJLN+1
+2 QUIT
+3 ;
ACTIONS() ;
+1 NEW DIC,X,Y
+2 SET Y=$PIECE($GET(^ORD(101,+$GET(^ORD(101,DA(1),10,DA,0)),0)),U)
IF Y=""
QUIT 0
+3 IF Y="PSJ LM DC"
QUIT $SELECT(PSGACT["D":1,1:0)
+4 IF Y="PSJU LM EDIT"
QUIT $SELECT(PSGACT["E":1,1:0)
+5 IF Y="PSJU LM RENEW"
QUIT $SELECT(PSGACT["R":1,1:0)
+6 IF Y="PSJ LM HOLD"
QUIT $SELECT(PSGACT["H":1,1:0)
+7 IF Y="PSJU LM VERIFY"
QUIT $SELECT(PSGACT["V":1,1:0)
+8 IF Y="PSJ LM EDIT NEW"
QUIT $SELECT(PSGACT["E":1,1:0)
+9 IF Y="PSJ LM FLAG"
QUIT $SELECT(PSGACT["G":1,1:0)
+10 QUIT 1
RNACT() ;
+1 IF '$GET(PSJRNF)
IF '$GET(PSJIRNF)
QUIT 0
+2 NEW X
SET X=$GET(^PS(53.1,+PSJORD,0))
+3 SET PSGACT=""
+4 IF $SELECT(+$PIECE(X,U,13):1,$GET(PSJRNF)&($PIECE(X,U,4)="U"):1,$GET(PSJIRNF)&($PIECE(X,U,4)'="U"):1,1:0)
SET PSGACT="BFDE"
+5 NEW X,Y
+6 SET Y=$PIECE($GET(^ORD(101,+$GET(^ORD(101,DA(1),10,DA,0)),0)),U)
IF Y=""
QUIT 0
+7 IF Y="PSJ LM DC"
QUIT $SELECT(PSGACT["D":1,1:0)
+8 IF Y="PSJ LM BYPASS"
QUIT $SELECT(PSGACT["B":1,1:0)
+9 IF Y="PSJ LM FINISH"
QUIT $SELECT(PSGACT["F":1,1:0)
+10 IF Y="PSJI LM DISCONTINUE"
QUIT $SELECT(PSGACT["D":1,1:0)
+11 IF Y="PSJI LM EDIT"
QUIT $SELECT(PSGACT["E":1,1:0)
+12 IF Y="PSJI LM FINISH"
QUIT $SELECT(PSGACT["F":1,1:0)
+13 IF Y="PSJ LM FLAG"
QUIT 0
+14 QUIT 1
+15 ;
TECHACT() ; Allowable actions for IV technician (PSJI PHARM TECH)
+1 if '$GET(PSJITECH)
QUIT 0
+2 NEW X
SET X=$GET(^PS(53.1,+PSJORD,0))
+3 IF $SELECT(+$PIECE(X,U,13):1,$PIECE(X,U,4)'="U":1,1:0)
SET PSGACT="F"
+4 NEW DIC,X,Y
+5 SET Y=$PIECE($GET(^ORD(101,+$GET(^ORD(101,DA(1),10,DA,0)),0)),U)
IF Y=""
QUIT 0
+6 IF Y="PSJ LM DC"
QUIT $SELECT(PSGACT["D":1,1:0)
+7 IF Y="PSJ LM BYPASS"
QUIT $SELECT(PSGACT["B":1,1:0)
+8 IF Y="PSJ LM FINISH"
QUIT $SELECT(PSGACT["F":1,1:0)
+9 IF Y="PSJI LM DISCONTINUE"
QUIT $SELECT(PSGACT["D":1,1:0)
+10 IF Y="PSJI LM EDIT"
QUIT $SELECT(PSGACT["E":1,1:0)
+11 IF Y="PSJI LM FINISH"
QUIT $SELECT(PSGACT["F":1,1:0)
+12 IF Y="PSJ LM FLAG"
QUIT 0
+13 QUIT 1
PATINFO() ; Determines if detailed allergy info can be displayed.
+1 SET Y=$PIECE($GET(^ORD(101,+$GET(^ORD(101,DA(1),10,DA,0)),0)),U)
IF Y=""
QUIT 0
+2 IF Y="PSJ LM SHOW PROFILE"
IF $DATA(PSJLMPRO)
QUIT 0
+3 QUIT 1
HIDDEN(CHK) ; Determines if certain Hidden actions are to be available.
+1 IF CHK="JUMP"
IF '$GET(PSJPNV)
DO NA("Jump is only available through Non-Verified/Pending Orders option.")
QUIT 0
+2 IF CHK="SPEED"
IF '$DATA(PSJUDPRF)
DO NA("Speed options are only available from the Unit Dose Order Entry Profile.")
QUIT 0
+3 ;PSJ*5*198;GMZ;Remove copy function from this option
+4 IF CHK="COPY"
IF ('$DATA(PSGACT)!($GET(PSGACT)=""))
DO NA("Copy is not allowed from this option.")
QUIT 0
+5 QUIT 1
+6 ;
NA(TXT) ;
+1 DO FULL^VALM1
WRITE !!,TXT,!!
NEW DIR
SET DIR(0)="E"
DO ^DIR
+2 QUIT
+3 ;
UPR(DFN) ; UPDATE PATIENT SPECIFIC DATA IN 55
+1 NEW DIE,DR
SET PSJC10=VALMCNT
+2 SET DA=DFN
SET DIE="^PS(55,"
SET DR="62.2;62.01"
DO ^DIE
DO DISALL^PSJLMUTL(DFN)
+3 SET VALMCNT=PSJC10
KILL PSJC10
+4 QUIT
+5 ;
DETALL(DFN) ; Enter Detailed Allergy Display list.
+1 DO EN^VALM("PSJ LM ALLERGY DISPLAY")
+2 QUIT
BRFALL(DFN) ;
+1 DO EN^VALM("PSJ LM BRIEF PATIENT INFO")
+2 QUIT
PAUSE ;
+1 NEW DIR
SET DIR(0)="E"
DO ^DIR
+2 QUIT
DRUGNAME(DFN,ON) ; Find drug name to display
+1 ;If order is in 55:
+2 ;.If Dosage Ordered is found, returns OI_U_Dosage Ordered.
+3 ;.If no Dosage Ordered, returns Dispense Drug only.
+4 ;If order in 53.1:
+5 ;.If Dosage Ordered, returns OI_U_Dosage Ordered.
+6 ;.If Dispense Drug is found, returns Dispense Drug name_U_Instructions.
+7 ;.If no dispense drug, returns OI_U_Instructions.
+8 IF ON["U"
Begin DoDot:1
+9 SET OIND=$GET(^PS(55,DFN,5,+ON,.2))
+10 IF $PIECE(OIND,U,2)]""
IF ($GET(^PS(50.7,+OIND,0))]"")
SET DN=$$OINAME(OIND)_U_.2
QUIT
+11 ;$S($P(OIND,U,2)]"":.2,1:.3) Q
SET X=+$ORDER(^PS(55,DFN,5,+ON,1,0))
SET X=$GET(^PS(55,DFN,5,+ON,1,X,0))
IF $PIECE(X,U)]""
SET DN=$$DDNAME(+X)_"^^"_$PIECE(X,"^",2)
QUIT
+12 SET DN=$$OINAME(+OIND)_U_.3
QUIT
End DoDot:1
QUIT DN
+13 SET OIND=$GET(^PS(53.1,+ON,.2))
if $PIECE(OIND,U,2)]""
QUIT $$OINAME(OIND)_U_.2
+14 SET X=+$ORDER(^PS(53.1,+ON,1,0))
IF X
IF '$ORDER(^PS(53.1,+ON,1,X))
SET X=$GET(^PS(53.1,+ON,1,X,0))
IF $PIECE(X,U)]""
QUIT $$DDNAME(+X)_U_.3_$PIECE(X,"^",2)
+15 QUIT $$OINAME(OIND)_U_.3
+16 ;
DDNAME(X) ;
+1 QUIT $$FOUND($PIECE($GET(^PSDRUG(+X,0)),U),X,"PSDRUG(,")
+2 ;
OINAME(ND) ; Return Orderable Item Name_" "_Dose Form_U_Dosage Ordered
+1 NEW DF,DNME,X
+2 SET X=$GET(^PS(50.7,+ND,0))
SET DNME=""
if X]""
SET DF=$PIECE($GET(^PS(50.606,+$PIECE(X,U,2),0)),U)
SET DNME=$PIECE(X,U)_" "_DF
+3 QUIT $$FOUND(DNME,+ND,"PS(50.7")
+4 ;
FOUND(DNME,DN,FN) ;
+1 QUIT $SELECT(DNME]"":DNME,1:"NOT FOUND "_DN_";"_FN)
