ORRCDPT1 ;SLC/MKB - Patient List for Nursing Dashboard ; 19 Sept 2003 10:10 AM
;;1.0;CARE MANAGEMENT;**5**;Jul 15, 2003;Build 4
;
EN(ORY,ORUSR,ORLST) ; -- Return each patient in ORLSTs for ORUSR
; where ORLST(#) = <list-type>:<list-ID>:<clinic start>:<clinic stop>
; in @ORY@(#) = "Patient=<dfn>^<name>^<ssn>^<dob>^<age>"
; = "Result=ORR:##^ORR:##^...^*ORR:##"
; = "Task=TSK:##^TSK:##^...^*TSK:##"
; = "Event=VST:ID^VST:ID^...^VST:ID"
; = "Unverified=ORV:##^...^ORV:##"
; = "Nursing=ORN:##^...^!ORN:##"
; = "Vital=VIT:ID^...^*VIT:ID"
; = "Error=^<error description>"
; RPC = ORRC NURS DASHBD PATIENTS
;
;
K ^TMP($J,"ORRCPTS"),^TMP($J,"ORRCY")
N ORI,ORX,X,ORID,ORBEG,OREND,ORTN,ORPAT,ORJ,PAT,ORDMIN,ORDMAX,ERRI
N ORSRV,FROM
S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
S FROM=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),"ORLP DEFAULT LIST SOURCE",1,"Q")
S ORUSR=+$G(ORUSR),ERRI=0 D PARAMS
S ORI=0 F S ORI=$O(ORLST(ORI)) Q:ORI<1 S ORX=$G(ORLST(ORI)) D
. S X=$$UP^XLFSTR($P(ORX,":")),ORID=+$P(ORX,":",2) D Q:'$G(ORPAT(1))
.. I X="X" D DEFLIST^ORQPTQ11(.ORPAT) D:$G(FROM)="M" Q
... S ORJ=0 F S ORJ=$O(^TMP("OR",$J,"PATIENTS",ORJ)) Q:ORJ<1 S PAT=+$G(^(ORJ,0)),ORPAT(ORJ)=PAT
.. I X="T" D TEAMPTS^ORQPTQ1(.ORPAT,ORID) Q
.. S ORTN=$S(X="P":"PROV",X="S":"SPEC",X="W":"WARD",X="C":"CLIN",1:"") Q:'$L(ORTN)
.. I X'="C" S ORTN=ORTN_"PTS^ORQPTQ2(.ORPAT,ORID)" D @ORTN Q
.. S ORBEG=$P(ORX,":",3),OREND=$P(ORX,":",4)
.. S ORTN=ORTN_"PTS^ORQPTQ2(.ORPAT,ORID,ORBEG,OREND)" D @ORTN
.. I $D(ORPAT(1)),'+$G(ORPAT(1)),ORPAT(1)'="^No appointments." S ERRI=ERRI+1,^TMP($J,"ORRCDPT1_ERROR",ERRI)=ORPAT(1)
. S ORJ=0 F S ORJ=$O(ORPAT(ORJ)) Q:ORJ<1 S PAT=+$G(ORPAT(ORJ)) D
.. Q:$D(^TMP($J,"ORRCY",PAT)) ;already processed
.. ; build ^TMP($J,"ORRCY",DFN,"<type>",ID)=* or null:
.. D RSLT,TASK,EVNT,UNVR,TEXT,VITL
.. S ^TMP($J,"ORRCY",PAT)="" ;return all pts on list
I $D(^TMP($J,"ORRCY")) D FORMAT
I $D(^TMP($J,"ORRCDPT1_ERROR")) D ERROR(.ORY)
K ^TMP($J,"ORRCY"),^TMP($J,"ORRCDPT1_ERROR")
Q
;
ERROR(ORY) ;Process errors to be returned
N I,J S I=0,J=0
I '$D(ORY) S ORY=$$GETRET
F S I=$O(@ORY@(I)) Q:I'>0 S J=I
S I=0
F S I=$O(^TMP($J,"ORRCDPT1_ERROR",I)) Q:I'>0 S J=J+1,@ORY@(J)="Error="_^TMP($J,"ORRCDPT1_ERROR",I)
Q
;
PARAMS ; -- Return date range parameters ORDMIN(type),ORDMAX(type) for ORUSR
N SERV,ORX,X,Y,%DT S SERV=+$G(^VA(200,ORUSR,5))
F ORX="RESULT","EVENT","TEXT ORDER","UNVERIFIED","VITALS" D
. S X=$$GET^XPAR("ALL^USR.`"_ORUSR_"^SRV.`"_SERV,"ORRC NURSE "_ORX_" DATE MIN"),%DT="TX"
. D ^%DT S ORDMIN(ORX)=$S(Y>0:Y,1:"")
. S X=$$GET^XPAR("ALL^USR.`"_ORUSR_"^SRV.`"_SERV,"ORRC NURSE "_ORX_" DATE MAX"),%DT="TX"
. D ^%DT S ORDMAX(ORX)=$S(Y>0:Y,1:"")
Q
;
RSLT ; -- find PAT's results unack'd by ORUSR
N ORACK,ORDBEG,ORDEND
S ORDBEG=ORDMIN("RESULT"),ORDEND=ORDMAX("RESULT")
D IDS^ORRCACK(.ORACK,PAT,ORUSR,ORDBEG,ORDEND)
M ^TMP($J,"ORRCY",PAT,"R")=@ORACK@(PAT) K @ORACK
Q
;
TASK ; -- find PAT's due tasks
N ORTSK
D IDS^ORRCTSK(.ORTSK,PAT)
M ^TMP($J,"ORRCY",PAT,"T")=@ORTSK@(PAT) K @ORTSK
Q
;
EVNT ; -- find PAT's appointments
N OREVT,ORABEG,ORAEND
S ORABEG=ORDMIN("EVENT"),ORAEND=ORDMAX("EVENT")
D IDS^ORRCEVT(.OREVT,PAT,ORABEG,ORAEND)
M ^TMP($J,"ORRCY",PAT,"E")=@OREVT@(PAT) K @OREVT
Q
;
UNVR ; -- find PAT's unverified orders, by nursing
N ORDER,ORDBEG,ORDEND
S ORDBEG=ORDMIN("UNVERIFIED"),ORDEND=ORDMAX("UNVERIFIED")
D IDS^ORRCOR(.ORDER,PAT,"ORV",ORDBEG,ORDEND)
M ^TMP($J,"ORRCY",PAT,"U")=@ORDER@(PAT) K @ORDER
Q
;
TEXT ; -- find patients with active generic text orders
N ORDER,ORDBEG,ORDEND
S ORDBEG=ORDMIN("TEXT ORDER"),ORDEND=ORDMAX("TEXT ORDER")
D IDS^ORRCOR(.ORDER,PAT,"ORN",ORDBEG,ORDEND)
M ^TMP($J,"ORRCY",PAT,"N")=@ORDER@(PAT) K @ORDER
Q
;
VITL ; -- find patients with recent vitals
N ORVIT,ORVBEG,ORVEND
S ORVBEG=ORDMIN("VITALS"),ORVEND=ORDMAX("VITALS")
D IDS^ORRCVIT(.ORVIT,PAT,ORVBEG,ORVEND)
M ^TMP($J,"ORRCY",PAT,"V")=@ORVIT@(PAT) K @ORVIT
Q
;
FORMAT ; -- Format return array ^TMP($J,"ORRCPTS") from temp array ^TMP($J,"ORRCY")
N ORPT,ORN,DFN,VADM,VA,VAERR
S ORY=$$GETRET
S (ORPT,ORN)=0 F S ORPT=$O(^TMP($J,"ORRCY",ORPT)) Q:ORPT<1 D
. S DFN=ORPT D DEM^VADPT
. S ORN=ORN+1,@ORY@(ORN)="Patient="_DFN_U_VADM(1)_U_VA("PID")_U_$$FMTHL7^XLFDT(+VADM(3))_U_VADM(4)
. I $D(^TMP($J,"ORRCY",ORPT,"R")) D ADD("Result")
. I $D(^TMP($J,"ORRCY",ORPT,"T")) D ADD("Task")
. I $D(^TMP($J,"ORRCY",ORPT,"E")) D ADD("Event")
. I $D(^TMP($J,"ORRCY",ORPT,"U")) D ADD("Unverified")
. I $D(^TMP($J,"ORRCY",ORPT,"N")) D ADD("Nursing")
. I $D(^TMP($J,"ORRCY",ORPT,"V")) D ADD("Vital")
Q
;
ADD(TYPE) ; -- Add item IDs from ^TMP($J,"ORRCY",PAT,<TYPE>) into return array
N ORX,ORSUB,ORID,X,ORU
S ORX=TYPE_"=",ORSUB=$E(TYPE),ORID="",ORU=""
F S ORID=$O(^TMP($J,"ORRCY",ORPT,ORSUB,ORID)) Q:ORID="" S X=$G(^(ORID))_ORID D
. I $L(ORX)+$L(X)>254 S ORN=ORN+1,@ORY@(ORN)=ORX,ORX=TYPE_"=",ORU=""
. S ORX=ORX_ORU_X,ORU=U
S ORN=ORN+1,@ORY@(ORN)=ORX
Q
;
GETRET() ;Returns the return variable pointer
Q $NA(^TMP($J,"ORRCPTS"))
;
ORRCDPT1 ;SLC/MKB - Patient List for Nursing Dashboard ; 19 Sept 2003 10:10 AM
+1 ;;1.0;CARE MANAGEMENT;**5**;Jul 15, 2003;Build 4
+2 ;
EN(ORY,ORUSR,ORLST) ; -- Return each patient in ORLSTs for ORUSR
+1 ; where ORLST(#) = <list-type>:<list-ID>:<clinic start>:<clinic stop>
+2 ; in @ORY@(#) = "Patient=<dfn>^<name>^<ssn>^<dob>^<age>"
+3 ; = "Result=ORR:##^ORR:##^...^*ORR:##"
+4 ; = "Task=TSK:##^TSK:##^...^*TSK:##"
+5 ; = "Event=VST:ID^VST:ID^...^VST:ID"
+6 ; = "Unverified=ORV:##^...^ORV:##"
+7 ; = "Nursing=ORN:##^...^!ORN:##"
+8 ; = "Vital=VIT:ID^...^*VIT:ID"
+9 ; = "Error=^<error description>"
+10 ; RPC = ORRC NURS DASHBD PATIENTS
+11 ;
+12 ;
+13 KILL ^TMP($JOB,"ORRCPTS"),^TMP($JOB,"ORRCY")
+14 NEW ORI,ORX,X,ORID,ORBEG,OREND,ORTN,ORPAT,ORJ,PAT,ORDMIN,ORDMAX,ERRI
+15 NEW ORSRV,FROM
+16 SET ORSRV=$GET(^VA(200,DUZ,5))
IF +ORSRV>0
SET ORSRV=$PIECE(ORSRV,U)
+17 SET FROM=$$GET^XPAR("USR^SRV.`"_+$GET(ORSRV),"ORLP DEFAULT LIST SOURCE",1,"Q")
+18 SET ORUSR=+$GET(ORUSR)
SET ERRI=0
DO PARAMS
+19 SET ORI=0
FOR
SET ORI=$ORDER(ORLST(ORI))
IF ORI<1
QUIT
SET ORX=$GET(ORLST(ORI))
Begin DoDot:1
+20 SET X=$$UP^XLFSTR($PIECE(ORX,":"))
SET ORID=+$PIECE(ORX,":",2)
Begin DoDot:2
+21 IF X="X"
DO DEFLIST^ORQPTQ11(.ORPAT)
IF $GET(FROM)="M"
Begin DoDot:3
+22 SET ORJ=0
FOR
SET ORJ=$ORDER(^TMP("OR",$JOB,"PATIENTS",ORJ))
IF ORJ<1
QUIT
SET PAT=+$GET(^(ORJ,0))
SET ORPAT(ORJ)=PAT
End DoDot:3
QUIT
+23 IF X="T"
DO TEAMPTS^ORQPTQ1(.ORPAT,ORID)
QUIT
+24 SET ORTN=$SELECT(X="P":"PROV",X="S":"SPEC",X="W":"WARD",X="C":"CLIN",1:"")
IF '$LENGTH(ORTN)
QUIT
+25 IF X'="C"
SET ORTN=ORTN_"PTS^ORQPTQ2(.ORPAT,ORID)"
DO @ORTN
QUIT
+26 SET ORBEG=$PIECE(ORX,":",3)
SET OREND=$PIECE(ORX,":",4)
+27 SET ORTN=ORTN_"PTS^ORQPTQ2(.ORPAT,ORID,ORBEG,OREND)"
DO @ORTN
+28 IF $DATA(ORPAT(1))
IF '+$GET(ORPAT(1))
IF ORPAT(1)'="^No appointments."
SET ERRI=ERRI+1
SET ^TMP($JOB,"ORRCDPT1_ERROR",ERRI)=ORPAT(1)
End DoDot:2
IF '$GET(ORPAT(1))
QUIT
+29 SET ORJ=0
FOR
SET ORJ=$ORDER(ORPAT(ORJ))
IF ORJ<1
QUIT
SET PAT=+$GET(ORPAT(ORJ))
Begin DoDot:2
+30 ;already processed
IF $DATA(^TMP($JOB,"ORRCY",PAT))
QUIT
+31 ; build ^TMP($J,"ORRCY",DFN,"<type>",ID)=* or null:
+32 DO RSLT
DO TASK
DO EVNT
DO UNVR
DO TEXT
DO VITL
+33 ;return all pts on list
SET ^TMP($JOB,"ORRCY",PAT)=""
End DoDot:2
End DoDot:1
+34 IF $DATA(^TMP($JOB,"ORRCY"))
DO FORMAT
+35 IF $DATA(^TMP($JOB,"ORRCDPT1_ERROR"))
DO ERROR(.ORY)
+36 KILL ^TMP($JOB,"ORRCY"),^TMP($JOB,"ORRCDPT1_ERROR")
+37 QUIT
+38 ;
ERROR(ORY) ;Process errors to be returned
+1 NEW I,J
SET I=0
SET J=0
+2 IF '$DATA(ORY)
SET ORY=$$GETRET
+3 FOR
SET I=$ORDER(@ORY@(I))
IF I'>0
QUIT
SET J=I
+4 SET I=0
+5 FOR
SET I=$ORDER(^TMP($JOB,"ORRCDPT1_ERROR",I))
IF I'>0
QUIT
SET J=J+1
SET @ORY@(J)="Error="_^TMP($JOB,"ORRCDPT1_ERROR",I)
+6 QUIT
+7 ;
PARAMS ; -- Return date range parameters ORDMIN(type),ORDMAX(type) for ORUSR
+1 NEW SERV,ORX,X,Y,%DT
SET SERV=+$GET(^VA(200,ORUSR,5))
+2 FOR ORX="RESULT","EVENT","TEXT ORDER","UNVERIFIED","VITALS"
Begin DoDot:1
+3 SET X=$$GET^XPAR("ALL^USR.`"_ORUSR_"^SRV.`"_SERV,"ORRC NURSE "_ORX_" DATE MIN")
SET %DT="TX"
+4 DO ^%DT
SET ORDMIN(ORX)=$SELECT(Y>0:Y,1:"")
+5 SET X=$$GET^XPAR("ALL^USR.`"_ORUSR_"^SRV.`"_SERV,"ORRC NURSE "_ORX_" DATE MAX")
SET %DT="TX"
+6 DO ^%DT
SET ORDMAX(ORX)=$SELECT(Y>0:Y,1:"")
End DoDot:1
+7 QUIT
+8 ;
RSLT ; -- find PAT's results unack'd by ORUSR
+1 NEW ORACK,ORDBEG,ORDEND
+2 SET ORDBEG=ORDMIN("RESULT")
SET ORDEND=ORDMAX("RESULT")
+3 DO IDS^ORRCACK(.ORACK,PAT,ORUSR,ORDBEG,ORDEND)
+4 MERGE ^TMP($JOB,"ORRCY",PAT,"R")=@ORACK@(PAT)
KILL @ORACK
+5 QUIT
+6 ;
TASK ; -- find PAT's due tasks
+1 NEW ORTSK
+2 DO IDS^ORRCTSK(.ORTSK,PAT)
+3 MERGE ^TMP($JOB,"ORRCY",PAT,"T")=@ORTSK@(PAT)
KILL @ORTSK
+4 QUIT
+5 ;
EVNT ; -- find PAT's appointments
+1 NEW OREVT,ORABEG,ORAEND
+2 SET ORABEG=ORDMIN("EVENT")
SET ORAEND=ORDMAX("EVENT")
+3 DO IDS^ORRCEVT(.OREVT,PAT,ORABEG,ORAEND)
+4 MERGE ^TMP($JOB,"ORRCY",PAT,"E")=@OREVT@(PAT)
KILL @OREVT
+5 QUIT
+6 ;
UNVR ; -- find PAT's unverified orders, by nursing
+1 NEW ORDER,ORDBEG,ORDEND
+2 SET ORDBEG=ORDMIN("UNVERIFIED")
SET ORDEND=ORDMAX("UNVERIFIED")
+3 DO IDS^ORRCOR(.ORDER,PAT,"ORV",ORDBEG,ORDEND)
+4 MERGE ^TMP($JOB,"ORRCY",PAT,"U")=@ORDER@(PAT)
KILL @ORDER
+5 QUIT
+6 ;
TEXT ; -- find patients with active generic text orders
+1 NEW ORDER,ORDBEG,ORDEND
+2 SET ORDBEG=ORDMIN("TEXT ORDER")
SET ORDEND=ORDMAX("TEXT ORDER")
+3 DO IDS^ORRCOR(.ORDER,PAT,"ORN",ORDBEG,ORDEND)
+4 MERGE ^TMP($JOB,"ORRCY",PAT,"N")=@ORDER@(PAT)
KILL @ORDER
+5 QUIT
+6 ;
VITL ; -- find patients with recent vitals
+1 NEW ORVIT,ORVBEG,ORVEND
+2 SET ORVBEG=ORDMIN("VITALS")
SET ORVEND=ORDMAX("VITALS")
+3 DO IDS^ORRCVIT(.ORVIT,PAT,ORVBEG,ORVEND)
+4 MERGE ^TMP($JOB,"ORRCY",PAT,"V")=@ORVIT@(PAT)
KILL @ORVIT
+5 QUIT
+6 ;
FORMAT ; -- Format return array ^TMP($J,"ORRCPTS") from temp array ^TMP($J,"ORRCY")
+1 NEW ORPT,ORN,DFN,VADM,VA,VAERR
+2 SET ORY=$$GETRET
+3 SET (ORPT,ORN)=0
FOR
SET ORPT=$ORDER(^TMP($JOB,"ORRCY",ORPT))
IF ORPT<1
QUIT
Begin DoDot:1
+4 SET DFN=ORPT
DO DEM^VADPT
+5 SET ORN=ORN+1
SET @ORY@(ORN)="Patient="_DFN_U_VADM(1)_U_VA("PID")_U_$$FMTHL7^XLFDT(+VADM(3))_U_VADM(4)
+6 IF $DATA(^TMP($JOB,"ORRCY",ORPT,"R"))
DO ADD("Result")
+7 IF $DATA(^TMP($JOB,"ORRCY",ORPT,"T"))
DO ADD("Task")
+8 IF $DATA(^TMP($JOB,"ORRCY",ORPT,"E"))
DO ADD("Event")
+9 IF $DATA(^TMP($JOB,"ORRCY",ORPT,"U"))
DO ADD("Unverified")
+10 IF $DATA(^TMP($JOB,"ORRCY",ORPT,"N"))
DO ADD("Nursing")
+11 IF $DATA(^TMP($JOB,"ORRCY",ORPT,"V"))
DO ADD("Vital")
End DoDot:1
+12 QUIT
+13 ;
ADD(TYPE) ; -- Add item IDs from ^TMP($J,"ORRCY",PAT,<TYPE>) into return array
+1 NEW ORX,ORSUB,ORID,X,ORU
+2 SET ORX=TYPE_"="
SET ORSUB=$EXTRACT(TYPE)
SET ORID=""
SET ORU=""
+3 FOR
SET ORID=$ORDER(^TMP($JOB,"ORRCY",ORPT,ORSUB,ORID))
IF ORID=""
QUIT
SET X=$GET(^(ORID))_ORID
Begin DoDot:1
+4 IF $LENGTH(ORX)+$LENGTH(X)>254
SET ORN=ORN+1
SET @ORY@(ORN)=ORX
SET ORX=TYPE_"="
SET ORU=""
+5 SET ORX=ORX_ORU_X
SET ORU=U
End DoDot:1
+6 SET ORN=ORN+1
SET @ORY@(ORN)=ORX
+7 QUIT
+8 ;
GETRET() ;Returns the return variable pointer
+1 QUIT $NAME(^TMP($JOB,"ORRCPTS"))
+2 ;
