source: FOIAVistA/trunk/r/CARE_MANAGEMENT-ORRC/ORRCTSK.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 7.9 KB
Line 
1ORRCTSK ;SLC/MKB -- Patient Task file #102.3 utilities ; 25 Jul 2003 9:31 AM
2 ;;1.0;CARE MANAGEMENT;;Jul 15, 2003
3 ;
4 ; ID = "TSK:"_task# everywhere below
5 ;
6PATS(ORY,ORUSR) ; -- Return list of patients for whom ORUSR has tasks due
7 ; in @ORY@(PAT) = #tasks ^ 1 if any are high priority
8 ; @ORY@(PAT,ID) = * if high priority, else null
9 ; [from ORRCDPT]
10 N ORPROV,DUE,PAT,CNT,ABN,IFN,X0
11 S ORY=$NA(^TMP($J,"ORRCTSK")) K @ORY
12 S ORUSR=+$G(ORUSR),DUE=$S($G(DT):DT,1:$P($$NOW^XLFDT,"."))
13 S PAT=0 F S PAT=+$O(^ORRT(102.3,"DUE",PAT)) Q:PAT<1 D
14 . I $D(^TMP($J,"ORRCLST")),'$D(^TMP($J,"ORRCY",PAT)) Q ;pt not on list
15 . S ORPROV=$$PROV(ORUSR,PAT),(CNT,ABN,IFN)=0
16 . F S IFN=+$O(^ORRT(102.3,"DUE",PAT,IFN)) Q:IFN<1 D
17 .. S X0=$G(^ORRT(102.3,IFN,0)) I $P(X0,U,5),$P($P(X0,U,5),".")>DUE Q
18 .. I $P(X0,U,2)'=+ORUSR,'ORPROV Q ;not linked provider
19 .. S @ORY@(PAT,"TSK:"_IFN)=$S($P(X0,U,4)="H":"*",1:"")
20 .. S CNT=CNT+1 S:$P(X0,U,4)="H" ABN=1
21 . I CNT S @ORY@(PAT)=CNT_U_ABN
22 Q
23 ;
24IDS(ORY,PAT) ; -- Return due tasks for PAT
25 ; in @ORY@(PAT) = #tasks ^ 1 if any are high priority
26 ; @ORY@(PAT,ID) = * if high priority, else null
27 ; [from ORRCDPT1]
28 N DUE,CNT,ABN,IFN,X0
29 S ORY=$NA(^TMP($J,"ORRCTSK")) K @ORY
30 S DUE=$S($G(DT):DT,1:$P($$NOW^XLFDT,".")),CNT=0,ABN=""
31 S IFN=0 F S IFN=+$O(^ORRT(102.3,"DUE",PAT,IFN)) Q:IFN<1 D
32 . S X0=$G(^ORRT(102.3,IFN,0)) I $P(X0,U,5),$P($P(X0,U,5),".")>DUE Q
33 . S @ORY@(PAT,"TSK:"_IFN)=$S($P(X0,U,4)="H":"*",1:"")
34 . S CNT=CNT+1 S:$P(X0,U,4)="H" ABN=1
35 S:CNT @ORY@(PAT)=CNT_U_ABN
36 Q
37 ;
38PROV(USR,PAT) ; -- Return 1 or 0, if USR is a provider for PAT
39 N Y,LIST S Y=0 S USR=+$G(USR),PAT=+$G(PAT)
40 I +$G(^DPT(PAT,.104))=USR S Y=1 G PVQ ;Prim Prov
41 I +$G(^DPT(PAT,.1041))=USR S Y=1 G PVQ ;Attending Prov
42 S PAT=PAT_";DPT(",LIST=0
43 F S LIST=+$O(^OR(100.21,"AB",PAT,LIST)) Q:LIST<1 I $G(^OR(100.21,LIST,1,USR,0)) S Y=1 Q
44PVQ Q Y
45 ;
46LIST(ORY,ORPAT,ORUSR,ORDUE) ; -- Return incomplete[ORDUE] tasks [by ORUSR] for ORPAT
47 ; in ORY(#) = ID^subject^date created^who created^patient^priority^due^date completed^who completed^date canceled^who canceled^items
48 ; RPC = ORRC TASKS BY PATIENT
49 N ORN,ORPROV,IFN,X0,X1,I,ITMS,X K ORY
50 S ORN=0,ORPAT=+$G(ORPAT),ORPROV=$S($G(ORUSR):$$PROV(ORUSR,ORPAT),1:"")
51 I $G(ORDUE) S ORDUE=$$HL7TFM^XLFDT(ORDUE)
52 S IFN=0 F S IFN=+$O(^ORRT(102.3,"DUE",ORPAT,IFN)) Q:IFN<1 D
53 . S X0=$G(^ORRT(102.3,IFN,0)),X1=$G(^(1)),ITMS=""
54 . I $G(ORDUE),$P(X0,U,5),$P($P(X0,U,5),".")>ORDUE Q ;future-not due yet
55 . I $G(ORUSR),$P(X0,U,2)'=+ORUSR,'ORPROV Q ;not linked prov
56 . F I=1,5,6,8 S X=$P(X0,U,I) I $L(X) S $P(X0,U,I)=$$FMTHL7^XLFDT(X)
57 . S I=0 F S I=$O(^ORRT(102.3,IFN,2,I)) Q:I<1 S X=$G(^(I,0)),ITMS=ITMS_$S($L(ITMS):"~",1:"")_X
58 . S $P(X0,U,10)=ITMS,ORN=ORN+1,ORY(ORN)="TSK:"_IFN_U_X1_U_X0
59 Q
60 ;
61DUE(ORY,ORPAT) ; -- Return tasks that are due for ORPAT
62 ; in ORY(#) = ID^subject^date created^who created^patient^priority^due^date completed^who completed^date canceled^who canceled^items
63 ; RPC = ORRC TASKS DUE BY PATIENT <not used>
64 N ORDT S ORDT=$$FMTHL7^XLFDT($G(DT))
65 D LIST(.ORY,ORPAT,,ORDT)
66 Q
67 ;
68DETAIL(ORY,TASK) ; -- Return details of TASKs
69 ; where TASK(#) = ID
70 ; in ORY(#) = ID^subject^date created^who created^patient^priority^due^date completed^who completed^date canceled^who canceled^items
71 ; RPC = ORRC TASKS BY ID
72 N ORN,ORI,ID,IFN,X0,X1,ITMS,I,X S ORN=0 K ORY
73 S ORI="" F S ORI=$O(TASK(ORI)) Q:ORI="" S ID=$G(TASK(ORI)) D
74 . S IFN=+$P(ID,":",2),X0=$G(^ORRT(102.3,IFN,0)),X1=$G(^(1))
75 . F I=1,5,6,8 S X=$P(X0,U,I) I $L(X) S $P(X0,U,I)=$$FMTHL7^XLFDT(X)
76 . S ITMS="",I=0 F S I=$O(^ORRT(102.3,IFN,2,I)) Q:I<1 S X=$G(^(I,0)),ITMS=ITMS_$S($L(ITMS):"~",1:"")_X
77 . S $P(X0,U,10)=ITMS,ORN=ORN+1,ORY(ORN)=ID_U_X1_U_X0
78 Q
79 ;
80NEW(ORY,DATA) ; -- Create new task
81 ; where DATA = [^]subject^date created^user^patient^priority^due^date completed^who completed^date canceled^who canceled^items
82 ; returns ORY = ID if successful, else 0^error message
83 ; RPC = ORRC TASK ADD
84 N DO,DIC,X,Y,I,ITMS S ORY=""
85 I '$L($G(DATA)) S ORY="0^Missing data string" Q
86 S DATA=U_DATA,ORY=$$VALID(.DATA) Q:'ORY ;invalid data
87 S DIC="^ORRT(102.3,",DIC(0)="",X=$P(DATA,U,3) S:X<1 X=$$NOW^XLFDT
88 D FILE^DICN I Y<1 S ORY="0^Unable to create new task" Q
89 S $P(^ORRT(102.3,+Y,0),U,2,9)=$P(DATA,U,4,11),^(1)=$P(DATA,U,2)
90 S ^ORRT(102.3,"C",+$P(DATA,U,5),+Y)=""
91 I '$P(DATA,U,8),'$P(DATA,U,10) S ^ORRT(102.3,"DUE",+$P(DATA,U,5),+Y)=""
92 S ITMS=$P(DATA,U,12) I $L(ITMS) D
93 . F I=1:1:$L(ITMS,"~") S X=$P(ITMS,"~",I) I $L(X) S ^ORRT(102.3,+Y,2,I,0)=X,^ORRT(102.3,+Y,2,"B",X,I)=""
94 . S ^ORRT(102.3,+Y,2,0)="^102.31AV^"_I_U_I
95 S ORY="TSK:"_+Y
96 Q
97 ;
98VALID(DATA) ; -- Returns 1 or 0^error if DATA string is valid
99 N X,Y,I,L S Y=1
100 S X=$P(DATA,U) I $L(X),'$D(^ORRT(102.3,+$P(X,":",2),0)) S Y="0^Invalid task number" G VQ
101 S X=$P(DATA,U,5) I X'=+X!(X<1)!'$D(^DPT(+X,0)) S Y="0^Missing or invalid patient ID" G VQ
102 F I=4,9 S X=$P(X,U,I) I $L(X),X'=+X!(X<1)!'$D(^VA(200,+X,0)) S Y="0^Missing or invalid user ID" G VQ
103 F I=3,7,8,10 S X=$P(DATA,U,I) I $L(X) D Q:'Y
104 . I $L(X)=12,$E(X,9,12)="0000" S X=$E(X,1,8) ;date only
105 . S X=$$HL7TFM^XLFDT(X) I $L(X) S $P(DATA,U,I)=X Q ;reformat
106 . S Y="0^Invalid date "_$S(I=3:"created",I=7:"due",1:"completed")
107 S X=$P(DATA,U,6) I $L(X),X'="L",X'="M",X'="H" S Y="0^Invalid priority" G VQ
108 S X=$P(DATA,U,2) I '$L(X)!(X["^")!($L(X)>100) S Y="0^Invalid subject text" G VQ
109 S X=$P(DATA,U,12) I $L(X) F I=1:1:$P(X,"~") S L=$P(X,"~",I) I $L(L),L'?3U1":".E S Y="0^Invalid linked item ID" Q
110VQ Q Y
111 ;
112EDIT(ORY,TASK) ; -- Change existing tasks
113 ; where TASK(#) = ID^subject^date created^user^patient^priority^due^date completed^who completed^date canceled^who canceled^items
114 ; returns ORY(#) = ID^1 or ID^0^error, if successful or not
115 ; RPC = ORRC TASK EDIT
116 N ORI,DATA,ID,DA,I,X,Y,SUBJ,ITMS,X0 K ORY
117 S ORI="" F S ORI=$O(TASK(ORI)) Q:ORI="" S DATA=$G(TASK(ORI)) D
118 . S ID=$P(DATA,U),DA=+$P(ID,":",2)
119 . I DA<1 S ORY(ORI)=ID_"^0^Invalid task number" Q
120 . S X=$$VALID(.DATA) I X<1 S ORY(ORI)=ID_U_X Q
121 . L +^ORRT(102.3,DA):5 I '$T S ORY(ORI)=ID_"^0^Another user is editing this task" Q
122 . S SUBJ=$P(DATA,U,2),ITMS=$P(DATA,U,12),DATA=$P(DATA,U,3,11)
123 . S X0=$G(^ORRT(102.3,DA,0)),^(0)=DATA,^(1)=SUBJ K ^(2) I $L(ITMS) D
124 .. F I=1:1:$L(ITMS,"~") S X=$P(ITMS,"~",I) I $L(X) S ^ORRT(102.3,DA,2,I,0)=X,^ORRT(102.3,DA,2,"B",X,I)=""
125 .. S ^ORRT(102.3,DA,2,0)="^102.31AV^"_I_U_I
126 . I $P(X0,U)'=$P(DATA,U) K ^ORRT(102.3,"B",$P(X0,U),DA) S ^ORRT(102.3,"B",$P(DATA,U),DA)=""
127 . I $P(X0,U,3)'=$P(DATA,U,3) K ^ORRT(102.3,"C",$P(X0,U,3),DA) S ^ORRT(102.3,"C",$P(DATA,U,3),DA)=""
128 . K ^ORRT(102.3,"DUE",$P(X0,U,3),DA)
129 . I '$P(DATA,U,6),'$P(DATA,U,8) S ^ORRT(102.3,"DUE",$P(DATA,U,3),DA)=""
130 . S ORY(ORI)=ID_"^1" L -^ORRT(102.3,DA)
131 Q
132 ;
133COMP(ORY,ORUSR,TASK) ; -- Complete tasks by ORUSR
134 ; where TASK(#) = ID
135 ; returns ORY(#) = ID^1 or ID^0^error, if successful or not
136 ; RPC = ORRC TASK COMPLETE
137 N X,Y,ID,DA,DR,DIE,ORI
138 I $G(ORUSR)<1 S ORY(0)="0^Invalid user identifier" Q
139 S DIE="^ORRT(102.3,",DR="6///NOW;7///"_+ORUSR
140 S ORI="" F S ORI=$O(TASK(ORI)) Q:ORI="" S ID=TASK(ORI) D
141 . S DA=+$P(ID,":",2) I DA<1 S ORY(ORI)=ID_"^0^Invalid task number" Q
142 . L +^ORRT(102.3,DA):5 I '$T S ORY(ORI)=ID_"^0^Another user is editing this task" Q
143 . D ^DIE S ORY(ORI)=ID_"^1" L -^ORRT(102.3,DA)
144 Q
145 ;
146CANC(ORY,ORUSR,TASK) ; -- Cancel tasks by ORUSR
147 ; where TASK(#) = ID
148 ; returns ORY(#) = ID^1 or ID^0^error, if successful or not
149 ; RPC = ORRC TASK CANCEL
150 N X,Y,ID,DA,DR,DIE,ORI
151 I $G(ORUSR)<1 S ORY(0)="0^Invalid user identifier" Q
152 S DIE="^ORRT(102.3,",DR="8///NOW;9///"_+ORUSR
153 S ORI="" F S ORI=$O(TASK(ORI)) Q:ORI="" S ID=TASK(ORI) D
154 . S DA=+$P(ID,":",2) I DA<1 S ORY(ORI)=ID_"^0^Invalid task number" Q
155 . L +^ORRT(102.3,DA):5 I '$T S ORY(ORI)=ID_"^0^Another user is editing this task" Q
156 . D ^DIE S ORY(ORI)=ID_"^1" L -^ORRT(102.3,DA)
157 Q
158 ;
159SUBJ(ORY,ORPAT) ; -- Return list of task subjects used for ORPAT
160 ; as ORY(#) = task subject
161 N ORI,ORN K ORY S ORN=0
162 S ORI=0 F S ORI=$O(^ORRT(102.3,"C",ORPAT,ORI)) Q:ORI<1 D
163 . S X=$G(^ORRT(102.3,ORI,1)) Q:'$L(X)
164 . S ORN=ORN+1,ORY(ORN)=X
165 Q
Note: See TracBrowser for help on using the repository browser.