source: FOIAVistA/tag/r/CLINICAL_PROCEDURES-MD/MDWORSR.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: 6.8 KB
Line 
1MDWORSR ; HOIFO/NCA - Daily Schedule Studies;7/2/04 12:39 ;5/17/07 16:09
2 ;;1.0;CLINICAL PROCEDURES;**14**;Apr 01,2004;Build 20
3 ; Reference IA# 2263 [Supported] XPAR calls
4 ; 3067 [Private] Read fields in Consult file (#123) w/FM
5 ; 3468 [Subscription] Call GMRCCP
6 ; 3869 [Subscription] SDAMA202 calls
7 ; 10035 [Supported] Patient File Access
8 ; 10103 [Supported] XLFDT calls
9 ;
10EN1 ; Entry Point to process scheduled studies
11 N MDCON,MDERR,MDFDA,MDHOLD,MDL,MDL1,MDMAXD,MDNOW,MDSTAT,MDX,MDXY
12 S MDMAXD=DT+.24
13 S MDL=DT F S MDL=$O(^MDD(702,"ASD",MDL)) Q:MDL<1!(MDL>MDMAXD) F MDL1=0:0 S MDL1=$O(^MDD(702,"ASD",MDL,MDL1)) Q:MDL1<1 S MDX=$G(^MDD(702,MDL1,0)) D
14 .K MDFDA
15 .S MDCON=+$P(MDX,"^",5) Q:'MDCON
16 .S MDSTAT=$$GET1^DIQ(123,MDCON_",",8,"E")
17 .Q:MDSTAT="DISCONTINUED"!(MDSTAT="CANCELLED")
18 .Q:+$P(MDX,"^",9)>0
19 .S MDIENS=MDL1_",",MDXY=+$P(MDX,"^",4),MDHOLD="" I MDXY D
20 ..Q:$P(^MDS(702.01,MDXY,0),U,6)'=2
21 ..S MDHOLD=$P($G(^MDD(702,+MDL1,0)),"^",7),MDNOW=$$NOW^XLFDT()
22 ..S $P(^MDD(702,+MDL1,0),"^",7)=$S(MDNOW>MDL:MDL,1:MDNOW)
23 .S MDHL7=$$SUB^MDHL7B(MDL1)
24 .I +MDHL7=-1 S MDFDA(702,MDIENS,.09)=2,MDFDA(702,MDIENS,.08)=$P(MDHL7,U,2)
25 .I +MDHL7=1 S MDFDA(702,MDIENS,.02)=$$NOW^XLFDT(),MDFDA(702,MDIENS,.09)=5,MDFDA(702,MDIENS,.08)=""
26 .D:$D(MDFDA) FILE^DIE("","MDFDA","MDERR")
27 .S MDXY=+$P(MDX,"^",4) Q:'MDXY
28 .I $P(^MDS(702.01,MDXY,0),U,6)=2 D Q ; Renal Check-In
29 ..D CP^MDKUTL(+MDIENS)
30 ..S:$G(MDHOLD)'="" MDFDA(702,MDIENS,.07)=MDHOLD
31 ..S MDFDA(702,MDIENS,.09)=5
32 ..D FILE^DIE("","MDFDA","MDERR")
33 Q
34CLINICPT ; Check-in CP study with multiple results
35 N MD,MDCDT,MDCL,MDCOM,MDCON,MDDT,MDDX,MDEND,MDERR,MDFDA,MDHEMO,MDHL7,MDIEN,MDIENS,MDK,MDLP,MDLST,MDMULT,MDNODE,MDNUM,MDPT,MDRET,MDSCHD,MDVSTR,MDY,MDY1,MDYR,X,X1,X2
36 N MDHOLD,MDLST1,MDLST2,MDNEW S MDDT=DT\1,MDEND=DT+.24 N MDINP K ^TMP($J,"SDAMA202","GETPLIST"),^TMP("MDSTATUS",$J) S MDCOM=0,MDHOLD=""
37 S MDNUM=$$GET^XPAR("SYS","MD COMPL PROC DISPLAY DAYS",1)
38 I +MDNUM>0 S X1=DT,X2=-MDNUM D C^%DTC S MDCOM=X
39 D GETLST^XPAR(.MDLST,"SYS","MD CLINIC QUICK LIST")
40 D GETLST^XPAR(.MDLST1,"SYS","MD CLINICS WITH MULT PROC")
41 F MDLP=0:0 S MDLP=$O(^MDD(702,"AS",0,MDLP)) Q:MDLP<1 D
42 .S MDY=$G(^MDD(702,MDLP,0)) Q:+$P(MDY,"^",9)>0
43 .Q:$P(MDY,"^",7)'=""
44 .Q:'+$P(MDY,"^",5)!($P(MDY,"^",6)'="")
45 .Q:'+MDY
46 .I '+$G(^TMP("MDSTATUS",$J,+MDY,+$P(MDY,"^",4))) S ^TMP("MDSTATUS",$J,+MDY,+$P(MDY,"^",4))=+MDLP
47 .Q
48 ; Combine clinics with multiple procedures to regular clinics
49 S MDLST2=$S(+MDLST>0:MDLST,1:0)
50 I MDLST1>0 K MDY F MDK=0:0 S MDK=$O(MDLST1(MDK)) Q:MDK<1 I $G(MDLST1(MDK))'="" S MDY=$P($G(MDLST1(MDK)),"^",2)_"^"_+$G(MDLST1(MDK)),MDLST2=MDLST2+1,MDLST(MDLST2)=MDY
51 ; Match new studies with 0 status to appointments
52 N MDXX K MDY F MDK=0:0 S MDK=$O(MDLST(MDK)) Q:MDK<1 S MDY=$G(MDLST(MDK)) I +$P(MDY,"^",2)>0 S MDCL=+MDY D
53 .K ^TMP($J,"SDAMA202","GETPLIST")
54 .D GETPLIST^SDAMA202(+MDY,"1;4;","R",MDDT,MDEND,.MDRET,"")
55 .F MD=0:0 S MD=$O(^TMP($J,"SDAMA202","GETPLIST",MD)) Q:'MD D
56 ..S MDY1=+$G(^TMP($J,"SDAMA202","GETPLIST",MD,4)) Q:MDY1<1
57 ..S MDSCHD=+$G(^TMP($J,"SDAMA202","GETPLIST",MD,1))
58 ..S MDDX=+$G(^TMP("MDSTATUS",$J,MDY1,+$P(MDY,"^",2))) Q:'MDDX
59 ..S MDMULT=+$$GET1^DIQ(702,+MDDX,".04:.12","I")
60 ..S MDHEMO=+$$GET1^DIQ(702,+MDDX,".04:.06","I"),MDIENS=+MDDX_","
61 ..S MDFDA(702,MDIENS,.02)=$$NOW^XLFDT()
62 ..S MDFDA(702,MDIENS,.07)="A;"_MDSCHD_";"_MDCL
63 ..S MDFDA(702,MDIENS,.14)=MDSCHD
64 ..D:$D(MDFDA) FILE^DIE("","MDFDA","MDERR") K MDFDA
65 ..I MDHEMO=2 S MDHOLD=$P($G(^MDD(702,+MDIENS,0)),"^",7),MDNEW=$$NOW^XLFDT(),$P(^MDD(702,+MDIENS,0),"^",7)=$S(MDNEW>MDSCHD:MDSCHD,1:MDNEW)
66 ..S MDHL7=$$SUB^MDHL7B(+MDIENS)
67 ..I +MDHL7=-1 S MDFDA(702,MDIENS,.09)=2,MDFDA(702,MDIENS,.08)=$P(MDHL7,U,2)
68 ..I +MDHL7=1 S MDFDA(702,MDIENS,.09)=5,MDFDA(702,MDIENS,.08)=""
69 ..D:$D(MDFDA) FILE^DIE("","MDFDA","MDERR")
70 ..Q:'+$G(MDIENS)
71 ..I MDHEMO=2 D CP^MDKUTL(+MDIENS) S:$G(MDHOLD)'="" MDFDA(702,+MDIENS_",",.07)=MDHOLD S MDFDA(702,+MDIENS_",",.09)=5 D FILE^DIE("","MDFDA","MDERR") K MDFDA
72 ..Q
73 .Q
74 ; Match the rest of appointments with previous studies
75 N MDGET,MDINST S X1=DT,X2=-365 D C^%DTC S MDCDT=X
76 F MDK=0:0 S MDK=$O(MDLST(MDK)) Q:MDK<1 S MDY=$G(MDLST(MDK)) I +$P(MDY,"^",2)>0 S MDCL=+MDY D
77 .K ^TMP($J,"SDAMA202","GETPLIST")
78 .D GETPLIST^SDAMA202(+MDY,"1;4;","R",MDDT,MDEND,.MDRET,"")
79 .F MD=0:0 S MD=$O(^TMP($J,"SDAMA202","GETPLIST",MD)) Q:'MD D
80 ..S MDINP=0
81 ..S MDY1=+$G(^TMP($J,"SDAMA202","GETPLIST",MD,4)) Q:MDY1<1
82 ..S MDSCHD=+$G(^TMP($J,"SDAMA202","GETPLIST",MD,1))
83 ..S MDPT=MDY1 Q:+$$GSTUDY(MDPT,MDSCHD)
84 ..S MDDX=$$GETC(MDPT,+$P(MDY,"^",2)) Q:'+MDDX
85 ..S MDNODE=$G(^MDD(702,+MDDX,0))
86 ..S:$G(^DPT(MDY1,.105))'="" MDINP=1
87 ..S MDCON=$P(MDNODE,"^",5) Q:'MDCON
88 ..S MDVSTR=$P(MDNODE,"^",7) Q:MDVSTR=""
89 ..S MDMULT=+$$GET1^DIQ(702,+MDDX,".04:.12","I")
90 ..S MDHEMO=+$$GET1^DIQ(702,+MDDX,".04:.06","I")
91 ..S MDYR=$S(MDMULT<1:MDCOM,1:MDCDT)
92 ..Q:$P(MDNODE,"^",2)<MDYR
93 ..Q:'+$P(MDNODE,"^",6)
94 ..Q:'$P(MDNODE,"^",9)
95 ..Q:$P(MDNODE,"^",9)>3
96 ..Q:MDMULT'=1&(MDHEMO<2)
97 ..Q:$P(MDVSTR,";",2)=MDSCHD
98 ..S MDINST=+$$GINST(+$P(MDNODE,"^",4)) Q:'MDINST
99 ..K MDFDA,MDERR,MDIEN
100 ..S MDFDA(702,"+1,",.01)=MDY1
101 ..S MDFDA(702,"+1,",.02)=$$NOW^XLFDT()
102 ..S MDFDA(702,"+1,",.03)=$P(MDNODE,"^",3)
103 ..S MDFDA(702,"+1,",.04)=$P(MDNODE,"^",4)
104 ..S MDFDA(702,"+1,",.05)=MDCON
105 ..S MDFDA(702,"+1,",.07)="A;"_MDSCHD_";"_MDCL
106 ..S MDFDA(702,"+1,",.11)=+MDINST
107 ..S MDFDA(702,"+1,",.14)=MDSCHD
108 ..D UPDATE^DIE("","MDFDA","MDIEN","MDERR") Q:$D(MDERR) K MDFDA
109 ..S MDIENS=MDIEN(1)_"," I MDHEMO=2 S MDHOLD=$P($G(^MDD(702,MDIEN(1),0)),"^",7),MDNOW=$$NOW^XLFDT(),$P(^MDD(702,MDIEN(1),0),"^",7)=$S(MDNOW>MDSCHD:MDSCHD,1:MDNOW)
110 ..S MDHL7=$$SUB^MDHL7B(MDIEN(1))
111 ..I +MDHL7=-1 S MDFDA(702,MDIENS,.09)=2,MDFDA(702,MDIENS,.08)=$P(MDHL7,U,2)
112 ..I +MDHL7=1 S MDFDA(702,MDIENS,.09)=5,MDFDA(702,MDIENS,.08)=""
113 ..D:$D(MDFDA) FILE^DIE("","MDFDA","MDERR")
114 ..Q:'+$G(MDIENS)
115 ..I MDHEMO=2 D CP^MDKUTL(+MDIENS) K MDFDA S:$G(MDHOLD)'="" MDFDA(702,+MDIENS_",",.07)=MDHOLD S MDFDA(702,+MDIENS_",",.09)=5 D FILE^DIE("","MDFDA","MDERR")
116 K ^TMP($J,"SDAMA202","GETPLIST"),^TMP("MDSTATUS",$J),MDFDA
117 Q
118GETC(MDPAT,MDDA) ; Get consult date
119 N MDX,MDCF S MDCF=0 K ^TMP("MDTMP",$J) D CPLIST^GMRCCP(MDPAT,+MDDA,$NA(^TMP("MDTMP",$J)))
120 S MDX=$O(^TMP("MDTMP",$J,""),-1) Q:'+MDX 0
121 I "saprc"'[$P($G(^TMP("MDTMP",$J,MDX)),U,4) S MDX=$O(^TMP("MDTMP",$J,MDX),-1) Q:'+MDX 0
122 I "saprc"[$P($G(^TMP("MDTMP",$J,MDX)),U,4) S MDCF=$P($G(^TMP("MDTMP",$J,MDX)),U,5)_"^"_$P($G(^TMP("MDTMP",$J,MDX)),U,1)
123 K ^TMP("MDTMP",$J)
124 Q $S(+MDCF:+$O(^MDD(702,"ACON",+MDCF,""),-1)_"^"_$P(MDCF,"^",2),1:0)
125GINST(MDDA) ; Get instrument from CP Definition
126 N MDIN,MDINT,Y1 S (MDINT,Y1)=0
127 F MDIN=0:0 S MDIN=$O(^MDS(702.01,+MDDA,.1,MDIN)) Q:MDIN<1!(+Y1) S MDINT=+$G(^(MDIN,0)) I +$$GET1^DIQ(702.09,MDINT,".13","I") S Y1=MDINT
128 Q Y1
129GSTUDY(MDPAT,MDDA) ;Get study for scheduled date/time
130 N MDIN,Y1 S Y1=0
131 F MDIN=0:0 S MDIN=$O(^MDD(702,"ASD",MDDA,MDIN)) Q:MDIN<1!(Y1>0) D
132 .S:$P($G(^MDD(702,MDIN,0)),"^")=MDPAT Y1=1
133 Q Y1
Note: See TracBrowser for help on using the repository browser.