source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDRPA08.m@ 1141

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

initial load of WorldVistAEHR

File size: 7.2 KB
Line 
1SDRPA08 ;BP-OIFO/OWAIN,ESW - Patient Appointment Data Compilation ; 9/10/04 9:41am
2 ;;5.3;Scheduling;**290,333,349,376**;AUG 13, 1993
3 ;This program generates appointment data into ^TMP("SDDPT",$J to be used by HL7 builder
4 Q
5 ;
6APPT(DFN,SDADT,SDDM,SDCL,SDSTAT) ;
7 ;SDDM - HL7 format of creation date
8 ;SDSTAT - string from SDRPA05
9 N ARRAY,SDCLNM,SDSTOP,SDSTOP1,SDCSTOP,SDCSTOP1,SDINST,SDFAC,SDSDDT,SDCDT,SDARF,SDARDT,SDENRO,SDNAVA,SD6A,SD8A,SD8RD
10 N SDNEW,SDSCHED,SDCHKOUT,SDPRVSEQ,SDCNT,SDSCE,SDSTOPD,SDCSTOPD
11 D GETS^DIQ(44,SDCL_",",".01;3;8;99;2503","I","ARRAY") ; GETS called to try to improve efficiency.
12 S SDCLNM=$G(ARRAY(44,SDCL_",",.01,"I")) ; Clinic name.
13 S SDSTOP1=$G(ARRAY(44,SDCL_",",8,"I")) ; DSS identifier of clinic.
14 S SDSTOP=$$GET1^DIQ(40.7,SDSTOP1_",",1,"I")
15 S SDSTOPD=$$GET1^DIQ(40.7,SDSTOP1_",",.01,"I") ;description
16 S SDCSTOP1=$G(ARRAY(44,SDCL_",",2503,"I")) ; DSS credit stop of clinic.
17 S SDCSTOP="",SDCSTOPD=""
18 I SDCSTOP1>0 S SDCSTOP=$$GET1^DIQ(40.7,SDCSTOP1_",",1,"I"),SDCSTOPD=$$GET1^DIQ(40.7,SDCSTOP1_",",.01,"I")
19 S SDINST=$G(ARRAY(44,SDCL_",",3,"I")) ; Institution
20 S SDFAC=$S(SDINST="":"",1:$$GET1^DIQ(4,SDINST_",",99,"I")) ; Station
21 I SDFAC="" S SDDIV=$$GET1^DIQ(44,SDCL_",",3.5,"I") D
22 .I SDDIV'="" S SDINST=$$GET1^DIQ(40.8,SDDIV_",",.07,"I") I SDINST'="" D
23 ..S SDFAC=$S(SDINST="":"",1:$$GET1^DIQ(4,SDINST_",",99,"I")) ; Station
24 .I SDDIV="" S SDFAC=$P($$SITE^VASITE(,),"^",3)
25 ;
26 ;N SEQ S SEQ=0 F S SEQ=$O(^SC(SDCL,"S",SDADT,1,SEQ)) Q:+SEQ'=SEQ I $P(^SC(SDCL,"S",SDADT,1,SEQ,0),"^")=DFN Q
27 ;S SDCHKOUT=$$DTCONV($$GET1^DIQ(44.003,SEQ_","_SDADT_","_SDCL_",",303,"I")) ; Checked out date.
28 S SDCHKOUT=""
29 I $P(SDSTAT,"^",5)'="" S SDCHKOUT=$$DTCONV($P(SDSTAT,"^",5))
30 S SD8RD=""
31 I $P(SDSTAT,"^",7)'="" S SD8RD=$$DTCONV($P(SDSTAT,"^",7))
32 S SDSDDT=$$DTCONV($$GET1^DIQ(2.98,SDADT_","_DFN_",",27,"I")) ; desired date
33 S SDCDT=$$GET1^DIQ(2.98,SDADT_","_DFN_",",15,"I") ; Cancellation date.
34 S SDARF=$S($$GET1^DIQ(2.98,SDADT_","_DFN_",",25,"I")="A":"A",1:"") ; Auto-rebook flag.
35 S SDARDT=$$DTCONV($$GET1^DIQ(2.98,SDADT_","_DFN_",",12,"I")) ; Auto-rebook date.
36 S SDNAVA=$$GET1^DIQ(2.98,SDADT_","_DFN_",",26,"I") ; Next available appointment indicator.
37 I SDNAVA=0 D
38 .I SDARF="A" S SDNAVA=4
39 .E S SDNAVA=5
40 I SDNAVA="" S SDNAVA=6
41 S SDNEW=$$NEWAT(DFN,SDADT,SDSTOP1,SDCSTOP1,SDFAC) ; New to facility/clinic flag.
42 ;
43 S SD6A=$P(SDSTAT,"^",3) S SD8A=$P(SDSTAT,"^",4)
44 S ^TMP("SDDPT",$J,DFN,SDADT)=$$DTCONV(SDADT)_"^"_SDDM_"^"_SDSDDT_"^^"_SDNAVA_"^"_SDCHKOUT_"^"_$$DTCONV(SDCDT)_"^^"_SDARDT
45 S ^TMP("SDDPT",$J,DFN,SDADT)=^TMP("SDDPT",$J,DFN,SDADT)_"^"_SDNEW_"^^"_SDCL_"^"_SDCLNM_"^"_SDSTOP_"^"_SDCSTOP_"^"_SDFAC
46 S ^TMP("SDDPT",$J,DFN,SDADT,"SCH")=$P(SDSTAT,U,1,6)_U_SD8RD
47 S ^TMP("SDDPT",$J,DFN,SDADT,"STDC")=SDSTOPD_"^"_SDCSTOPD
48 ; Outpatient classification.
49 S SDSCE=$$GET1^DIQ(2.98,SDADT_","_DFN_",",21,"I")
50 I SDSCE'="" D EN^VAFHLZCL(DFN,SDSCE,"1,2,3","","^","^TMP(""SDDPT"",$J,DFN,SDADT,""ZCL"")")
51 ;get patient class
52 D GETAPPT^SDAMA201(DFN,"12",,SDADT,SDADT) N SDPATCL D K ^TMP($J,"SDAMA201")
53 .S SDPATCL=$G(^TMP($J,"SDAMA201","GETAPPT",1,12))
54 .I SDPATCL="" D
55 ..I SDSCE'="" N SDVST S SDVST=$$GET1^DIQ(409.68,SDSCE_",",.05,"I") D
56 ...I SDVST S SDPATCL=$$GET1^DIQ(9000010,SDVST_",",15002,"I")
57 ...S SDPATCL=$S(SDPATCL=1:"I",SDPATCL=0:"O",1:"U")
58 ..I SDSCE="" S SDPATCL="U"
59 .S $P(^TMP("SDDPT",$J,DFN,SDADT),"^",4)=SDPATCL
60 ; Get providers for clinic.
61 N SDPROV S (SDPRVSEQ,SDCNT)=0,SDPROV=""
62 N PROVID
63 F S SDPRVSEQ=$O(^SC(SDCL,"PR",SDPRVSEQ)) Q:+SDPRVSEQ'=SDPRVSEQ!(SDCNT>10) D
64 .S SDCNT=SDCNT+1,PROVID=$$GET1^DIQ(44.1,SDPRVSEQ_","_SDCL_",",.01,"I")
65 .S ^TMP("SDDPT",$J,DFN,SDADT,"ROL",SDCNT)="ROL^"_SDCNT_"^"_PROVID_"^"_$$GET1^DIQ(200,PROVID_",",.01,"I")
66 .Q
67 Q
68NEWAT(DFN,SDADT,SDSTOP1,SDCSTOP1,SDFAC) ; New to facility/clinic flag.
69 N OK,SDADT0,SDFAC1,SDDIV
70 S OK=0,SDADT0=SDADT
71 F S SDADT=$O(^DPT(DFN,"S",SDADT),-1) Q:'SDADT Q:$$GT24(SDADT,SDADT0) D Q:OK
72 .N SDCL,SDDIV,ARRAY
73 .S SDCL=$$GET1^DIQ(2.98,SDADT_","_DFN_",",.01,"I")
74 .Q:$$GET1^DIQ(44,SDCL_",",8,"I")'=SDSTOP1
75 .Q:$$GET1^DIQ(44,SDCL_",",2503,"I")'=SDCSTOP1
76 .D GETS^DIQ(44,SDCL_",","3","I","ARRAY")
77 .S SDINST=$G(ARRAY(44,SDCL_",",3,"I")) ; Institution
78 .S SDFAC1=$S(SDINST="":"",1:$$GET1^DIQ(4,SDINST_",",99,"I")) ; Facility.
79 .I SDFAC1="" S SDDIV=$$GET1^DIQ(44,SDCL_",",3.5,"I") I SDDIV'="" D
80 ..S SDINST=$$GET1^DIQ(40.8,SDDIV_",",.07,"I") I SDINST'="" D
81 ...S SDFAC1=$S(SDINST="":"",1:$$GET1^DIQ(4,SDINST_",",99,"I")) ; Facility.
82 .I SDFAC1="" D
83 ..I SDDIV'="" S SDFAC1=$P($$SITE^VASITE(,SDDIV),"^",3) Q
84 ..S SDFAC1=$P($$SITE^VASITE(,),"^",3)
85 .I SDFAC1=SDFAC S OK=3
86 .Q
87 I OK Q OK
88 S SDADT=SDADT0
89 F S SDADT=$O(^DPT(DFN,"S",SDADT),-1) Q:'SDADT Q:$$GT24(SDADT,SDADT0) D Q:OK
90 .N SDCL,SDDIV,ARRAY
91 .S SDCL=$$GET1^DIQ(2.98,SDADT_","_DFN_",",.01,"I")
92 .Q:$$GET1^DIQ(44,SDCL_",",8,"I")'=SDSTOP1
93 .D GETS^DIQ(44,SDCL_",","3","I","ARRAY")
94 .S SDINST=$G(ARRAY(44,SDCL_",",3,"I")) ; Institution
95 .S SDFAC1=$S(SDINST="":"",1:$$GET1^DIQ(4,SDINST_",",99,"I")) ; Facility.
96 .I SDFAC1="" S SDDIV=$$GET1^DIQ(44,SDCL_",",3.5,"I") I SDDIV'="" D
97 ..S SDINST=$$GET1^DIQ(40.8,SDDIV_",",.07,"I") I SDINST'="" D
98 ...S SDFAC1=$S(SDINST="":"",1:$$GET1^DIQ(4,SDINST_",",99,"I")) ; Facility.
99 .I SDFAC1="" D
100 ..I SDDIV'="" S SDFAC1=$P($$SITE^VASITE(,SDDIV),"^",3) Q
101 ..S SDFAC1=$P($$SITE^VASITE(,),"^",3)
102 .I $E(SDFAC1,1,3)=$E(SDFAC,1,3) S OK=2
103 .Q
104 I OK Q OK
105 S OK=1 Q OK
106 ;
107GT24(DATE1,DATE2) ; Are two dates greater than 24 months apart?
108 ; DATE1 should be before DATE2.
109 ; If they are not in that order, they are swapped anyway.
110 N MONTHS,TEMP
111 I DATE1>DATE2 S TEMP=DATE1,DATE1=DATE2,DATE2=TEMP
112 S MONTHS=$E(DATE2,2,3)-$E(DATE1,2,3)*12+$E(DATE2,4,5)-$E(DATE1,4,5)
113 Q MONTHS>24
114DPT(DFN,SDCE) ;
115 ; Extrinsic. Returns boolean, 0: ^TMP("SDDPT",$J,DFN) not created; 1: created.
116 ;
117 N SDNAMEL,SDNAMEF,SDNAMEM,SDNAMES,SDNAME,NAME,DOB,SSN,SSNP,SDSC,ICN,SDADT,SDSCP,ARRAY,SDDCE
118 S SDDCE=$$GET1^DIQ(2,DFN_",",27.01,"I") ; Current enrollment. Required elsewhere.
119 S:SDDCE="" SDCE="" I SDDCE>0 S SDCE=$$GET1^DIQ(27.11,SDDCE_",",.07,"I") ; Enrollment priority
120 Q:$D(^TMP("SDDPT",$J,DFN)) 1
121 D GETS^DIQ(2,DFN_",",".301;.302;991.01","I","ARRAY") ; GETS called to try to improve efficiency.
122 S SDSC=$G(ARRAY(2,DFN_",",.301,"I")) ; Service connected.
123 S SDSCP=$G(ARRAY(2,DFN_",",.302,"I")) ; Service connected percentage.
124 S ICN=$$GETICN^MPIF001(DFN) ; Integration Control Number.
125 I +ICN<0 S ICN="" ;
126 D DEM^VADPT ;VADM array as output of this call
127 S (SDNAMEL,SDNAMEF,SDNAMEM,SDNAMES,SDNAME,NAME(1))=""
128 S NAME=$$GETNAME(DFN)
129 S DOB=$$DTCONV($P($G(VADM(3)),"^")) ; Date of birth.
130 S (SSN,SSNP)="" S SSN=$P($G(VADM(2)),"^") I SSN["P" S SSNP="P",SSN=$E(SSN,1,9) ; Social security number.
131 Q:$E(SSN,1,5)="00000" 0 ; Exclude test patients.
132 ;
133 S ^TMP("SDDPT",$J,DFN)=ICN_"^"_SSN_SSNP_"^"_NAME_"^"_DOB_"^"_$E(SDSC)_"^"_SDSCP_"^"_SDCE
134 Q 1
135DTCONV(DT) ; Date conversion.
136 ; CYYMMDD -> CCYYMMDD
137 ; CYYMMDD.H{HMMSS} -> CCYYMMDDHHMM
138 I DT?7N Q DT+17E6
139 Q:DT?7N1"."1.6N DT\1+17E6_$E(DT#1+1*1E4,2,5)
140 Q ""
141GETNAME(NMID) ; Name in HL7 format.
142 N SDNAME,NAME,SDNAMEL,SDNAMF,SDNAMEM,SDNAMES,SDNAMEF
143 S SDNAME("FILE")=2,SDNAME("IENS")=NMID,SDNAME("FIELD")=.01
144 S NAME(1)=$$HLNAME^XLFNAME(.SDNAME,"","^")
145 S SDNAMEL=$P($G(NAME(1)),"^"),SDNAMEF=$P($G(NAME(1)),"^",2),SDNAMEM=$P($G(NAME(1)),"^",3),SDNAMES=$P($G(NAME(1)),"^",4)
146 Q SDNAMEL_"^"_SDNAMEF_"^"_SDNAMEM_" "_SDNAMES
147 Q
Note: See TracBrowser for help on using the repository browser.