- 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 ;
