source: FOIAVistA/tag/r/CARE_MANAGEMENT-ORRC/ORRCDPT.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.5 KB
Line 
1ORRCDPT ;SLC/MKB - Patient List for Physician Dashboard ; 19 Sept 2003 10:09 AM
2 ;;1.0;CARE MANAGEMENT;**5**;Jul 15, 2003;Build 4
3 ;
4MAIN(ORY,USER,TYPE,LIST) ; -- Return patient list for dashboard
5 ; where USER = pointer to #200
6 ; TYPE = (C)linician or (N)urse view
7 ; LIST(#) = <list-type>:<list-ID>:<clinic start>:<clinic stop>
8 ; RPC = ORRC DASHBOARD PATIENTS
9 ;
10 D EXPDATES(.LIST) ;expand dates
11 S USER=+$G(USER),TYPE=$$UP^XLFSTR($G(TYPE))
12 I TYPE="N" D EN^ORRCDPT1(.ORY,USER,.LIST) Q
13 I $O(LIST(0)) D EN1(.ORY,USER,.LIST) Q
14 D EN(.ORY,USER)
15 Q
16 ;
17EN(ORY,ORUSR) ; -- Return each patient to list on dashboard for ORUSR
18 ; in @ORY@(#) = "Patient=<dfn>^<name>^<ssn>^<dob>^<age>"
19 ; = "Result=ORR:##^ORR:##^...^*ORR:##"
20 ; = "Task=TSK:##^TSK:##^...^*TSK:##"
21 ; = "Event=VST:ID^VST:ID^...^VST:ID"
22 ; = "Unsigned=ORD:##^...^ORD:##^DOC:##^...^DOC:##"
23 ; = "Notifications=1"
24 ; RPC = ORRC PHY DASHBD PATIENTS
25 S ORUSR=+$G(ORUSR) K ^TMP($J,"ORRCPTS"),^TMP($J,"ORRCY"),^TMP($J,"ORRCLST")
26 D RSLT,TASK,EVNT,SIGN ;build ^TMP($J,"ORRCY",DFN,"<type>",ID)=* or null
27 I $D(^TMP($J,"ORRCY")) D FORMAT
28 K ^TMP($J,"ORRCY")
29 Q
30 ;
31EN1(ORY,ORUSR,ORLST) ; -- Return patients on ORLST for ORUSR's dashboard
32 ; in @ORY@(#) = "Patient=<dfn>^<name>^<ssn>^<dob>^<age>"
33 ; = "Result=ORR:##^ORR:##^...^*ORR:##"
34 ; = "Task=TSK:##^TSK:##^...^*TSK:##"
35 ; = "Event=VST:ID^VST:ID^...^VST:ID"
36 ; = "Unsigned=ORD:##^...^ORD:##^DOC:##^...^DOC:##"
37 ; = "Error=^<error description>"
38 N ORI,ORX,X,ORID,ORPAT,ORTN,ORBEG,OREND,ORJ,PAT,ERRI S ORUSR=+$G(ORUSR),ERRI=0
39 K ^TMP($J,"ORRCY"),^TMP($J,"ORRCNOTF"),^TMP($J,"ORRCPTS")
40 S ^TMP($J,"ORRCLST")=""
41 N ORSRV,FROM
42 S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
43 S FROM=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),"ORLP DEFAULT LIST SOURCE",1,"Q")
44 S ORI=0 F S ORI=$O(ORLST(ORI)) Q:ORI<1 S ORX=$G(ORLST(ORI)) D
45 . S X=$$UP^XLFSTR($P(ORX,":")),ORID=+$P(ORX,":",2) D Q:'$G(ORPAT(1))
46 .. I X="X" D DEFLIST^ORQPTQ11(.ORPAT) D:$G(FROM)="M" Q
47 ... S ORJ=0 F S ORJ=$O(^TMP("OR",$J,"PATIENTS",ORJ)) Q:ORJ<1 S PAT=+$G(^(ORJ,0)),^TMP($J,"ORRCY",PAT)=""
48 .. I X="T" D TEAMPTS^ORQPTQ1(.ORPAT,ORID) Q
49 .. S ORTN=$S(X="P":"PROV",X="S":"SPEC",X="W":"WARD",X="C":"CLIN",1:"") Q:'$L(ORTN)
50 .. I X'="C" S ORTN=ORTN_"PTS^ORQPTQ2(.ORPAT,ORID)" D @ORTN Q
51 .. S ORBEG=$P(ORX,":",3),OREND=$P(ORX,":",4)
52 .. D CLINPTS^ORQPTQ2(.ORPAT,ORID,ORBEG,OREND)
53 .. I $D(ORPAT(1)),'+$G(ORPAT(1)),ORPAT(1)'="^No appointments." S ERRI=ERRI+1,^TMP($J,"ORRCDPT_ERROR",ERRI)=ORPAT(1)
54 . S ORJ=0 F S ORJ=$O(ORPAT(ORJ)) Q:ORJ<1 S PAT=+$G(ORPAT(ORJ)),^TMP($J,"ORRCY",PAT)=""
55 I $D(^TMP($J,"ORRCY")) D ;there are patients on selected list(s)
56 . ; build ^TMP($J,"ORRCY",DFN,"<type>",ID)=* or null:
57 . D RSLT,TASK,EVNT,SIGN,FORMAT
58 D ERROR(.ORY)
59 K ^TMP($J,"ORRCY"),^TMP($J,"ORRCNOTF"),^TMP($J,"ORRCLST"),^TMP($J,"ORRCDPT_ERROR")
60 Q
61 ;
62ERROR(ORY) ; -- process errors
63 I '$D(^TMP($J,"ORRCDPT_ERROR")) Q
64 N I,J S I=0,J=0
65 I '$D(ORY) S ORY=$$GETRET
66 F S I=$O(@ORY@(I)) Q:I'>0 S J=I
67 S I=0
68 F S I=$O(^TMP($J,"ORRCDPT_ERROR",I)) Q:I'>0 S J=J+1,@ORY@(J)="Error="_^TMP($J,"ORRCDPT_ERROR",I)
69 Q
70 ;
71RSLT ; -- find patients with unack'd results for ORUSR's orders
72 N ORACK,PAT
73 D PATS^ORRCACK(.ORACK,ORUSR) S PAT=0
74 F S PAT=+$O(@ORACK@(PAT)) Q:PAT<1 M ^TMP($J,"ORRCY",PAT,"R")=@ORACK@(PAT)
75 K @ORACK
76 Q
77 ;
78TASK ; -- find patients with tasks not complete
79 N ORTSK,PAT
80 D PATS^ORRCTSK(.ORTSK,ORUSR) S PAT=0
81 F S PAT=+$O(@ORTSK@(PAT)) Q:PAT<1 M ^TMP($J,"ORRCY",PAT,"T")=@ORTSK@(PAT)
82 K @ORTSK
83 Q
84 ;
85EVNT ; -- find patients that ORUSR has outstanding ADT alerts for
86 N OREVT,PAT
87 D PATS^ORRCEVT(.OREVT,ORUSR) S PAT=0
88 F S PAT=+$O(@OREVT@(PAT)) Q:PAT<1 M ^TMP($J,"ORRCY",PAT,"E")=@OREVT@(PAT)
89 K @OREVT
90 Q
91 ;
92SIGN ; -- find patients that have orders or notes ORUSR needs to sign
93 N ORDER,ORDOC,PAT
94 ;D PTUNS^ORRCOR(.ORDER,ORUSR) S PAT=0
95 ;F S PAT=+$O(ORDER(PAT)) Q:PAT<1 M ^TMP($J,"ORRCY",PAT,"U")=ORDER(PAT)
96 D GETPTUNS^ORRCTIU(.ORDOC,ORUSR) S PAT=0
97 F S PAT=+$O(@ORDOC@(PAT)) Q:PAT<1 M ^TMP($J,"ORRCY",PAT,"U")=@ORDOC@(PAT)
98 K @ORDOC
99 Q
100 ;
101FORMAT ; -- Format return array ^TMP($J,"ORRCPTS") from temp array ^TMP($J,"ORRCY")
102 N ORPT,ORN,DFN,VADM,VA,VAERR
103 S ORY=$$GETRET
104 S (ORPT,ORN)=0 F S ORPT=$O(^TMP($J,"ORRCY",ORPT)) Q:ORPT<1 D
105 . S DFN=ORPT D DEM^VADPT
106 . S ORN=ORN+1,@ORY@(ORN)="Patient="_DFN_U_VADM(1)_U_VA("PID")_U_$$FMTHL7^XLFDT(+VADM(3))_U_VADM(4)
107 . I $D(^TMP($J,"ORRCY",ORPT,"R")) D ADD("Result")
108 . I $D(^TMP($J,"ORRCY",ORPT,"T")) D ADD("Task")
109 . I $D(^TMP($J,"ORRCY",ORPT,"E")) D ADD("Event")
110 . I $D(^TMP($J,"ORRCY",ORPT,"U")) D ADD("Unsigned")
111 . I $G(^TMP($J,"ORRCNOTF",ORPT)) S ORN=ORN+1,@ORY@(ORN)="Notifications=1"
112 Q
113 ;
114GETRET() ;Returns the return variable pointer
115 Q $NA(^TMP($J,"ORRCPTS"))
116 ;
117ADD(TYPE) ; -- Add item IDs from ^TMP($J,"ORRCY",PAT,<TYPE>) into return array
118 N ORX,ORSUB,ORID,X,ORU
119 S ORX=TYPE_"=",ORSUB=$E(TYPE),ORID="",ORU=""
120 F S ORID=$O(^TMP($J,"ORRCY",ORPT,ORSUB,ORID)) Q:ORID="" S X=$G(^(ORID))_ORID D
121 . I $L(ORX)+$L(X)>254 S ORN=ORN+1,@ORY@(ORN)=ORX,ORX=TYPE_"=",ORU=""
122 . S ORX=ORX_ORU_X,ORU=U
123 S ORN=ORN+1,@ORY@(ORN)=ORX
124 Q
125 ;
126EXPDATES(LIST) ;Expand dates for clinic appointments, if they need to be expanded. These would be a year or quarter indicators on clinic appt lists.
127 ;Ex. YC = current year, YC-4 = current year - 4, etc.
128 N I,RANGE S I=0
129 F S I=$O(LIST(I)) Q:I'>0 D
130 .I $P(LIST(I),":",1)="c",$L(LIST(I),":")=3 D
131 ..S RANGE=$$RNG2FM^ORRHCU($P(LIST(I),":",3))
132 ..S $P(LIST(I),":",3)=$P(RANGE,":",1)
133 ..S $P(LIST(I),":",4)=$P(RANGE,":",2)
134 Q
135 ;
Note: See TracBrowser for help on using the repository browser.