source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMG2E1.m@ 794

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

initial load of FOIAVistA 6/30/08 version

File size: 4.8 KB
Line 
1PXRMG2E1 ;SLC/JVS -GEC #2 Extract initial arrays ;7/14/05 08:10
2 ;;2.0;CLINICAL REMINDERS;**2,4**;Feb 04, 2005;Build 21
3 Q
4 ;
5 ;Arrays
6 ;^TMP("PXRMGEC",$J, = Root Reference
7 ;"REF",DATE,DFN) = Number of HF in Referral
8 ;"REFDFN",DFN) = Number of Referrals per Patient
9 ;"HS" = Heath Summary Array
10 Q
11GEC ;Get ien for GEC Date Sources
12 S (GEC1DA,GEC2DA,GEC3DA,GECFDA)=0
13 S GECFDA=$O(^PX(839.7,"B","GECF",0))
14 S GEC1DA=$O(^PX(839.7,"B","GEC1",0))
15 S GEC2DA=$O(^PX(839.7,"B","GEC2",0))
16 S GEC3DA=$O(^PX(839.7,"B","GEC3",0))
17 Q
18 ;
19RANG(BDT,EDT,VDT,SDT,CHK) ;Dates are in date range
20 ;S=start date F=finished date
21 N OK,SOK,FOK
22 S (SOK,FOK,OK)=0
23 I CHK["S" D
24 .S:($P(SDT,".",1)'<(BDT))&($P(SDT,".",1)'>(EDT)) SOK=1
25 I CHK["F" D
26 .S:($P(VDT,".",1)'<(BDT))&($P(VDT,".",1)'>(EDT)) FOK=1
27 S OK=$S(SOK=1:1,FOK=1:1,1:0)
28 I CHK["SF"&(SOK+FOK'=2) S OK=0
29 Q OK
30 ;
31FIN(DATE,DFN) ;Check to see if finished
32 N GEC,DA,VST,VDT,DONE
33 S DONE=0,VDT="0000000"
34 S GEC=0 F S GEC=$O(^AUPNVHF("AED",DATE,DFN,GEC)) Q:GEC="" D
35 .I GEC=GECFDA S DONE=1 D
36 ..;S DA=$O(^AUPNVHF("AED",DATE,DFN,GEC,0))
37 ..;S VST=$P($G(^AUPNVHF(DA,0)),"^",3)
38 ..;S VDT=$P($G(^AUPNVSIT(VST,0)),"^",1)
39 ..S VDT=DATE
40 Q DONE_"^"_VDT
41 ;
42E(ARY,FIN,BDT,EDT,CHK,DFNONLY,TPAT) ;EXTRACT GEC REFERRALS
43 N DATE,GEC,DFN,DA,DFNX,DATEX,ZALL,CNTREF,COMPLETE
44 N REFERAL,REFERA,LOCA,LOCN,LOC,DOC,DOCT,DOCTN,DOCTNA
45 N DOCTOR,DR,DONE,VDT,FLAG,DTCHK,DATE1,DFN1,DATEY,DFNXX
46 N GEC1DA,GEC2DA,GEC3DA,GECFDA,DFNFLAG
47 N TMPDFN,TMPDOC,TMPDT,TMPLOC
48 ;====================================================
49 K ^TMP("PXRMGEC",$J,"REF"),^TMP("PXRMGEC",$J,"REFDFN")
50 ;====================================================
51 ;Callers Responsibility to Kill the Array
52 ;(ARY,FIN,BDT,EDT,CHK,DFNONLY)
53 ;EXAMPLE FOR HEALTH SUMMARY
54 ;D E^PXRMGECV("HS",2,3020509,3030609,"S",0)
55 ;Parameters
56 ;S ARY="HS"
57 ;Array to Create HS,DT,DFN,DOC,LOC,HFCD
58 ;S FIN=0
59 ;finished referrals 1=finished 0=unfinished 2=Both ""=finished
60 ;S BDT=3020509 Begin Date
61 ;S EDT=3030609 End Date
62 ;S CHK="S"
63 ;Check dates S=Start date Default F=Final date for date range
64 ;S DFNONLY=0
65 ; DFN of patient 0 or all
66 ;=====================================================
67 ;Count of Referrals
68 S CNTREF=0
69 D GEC ;get iens for the GECF VARIABLES
70 ;==============
71 D WORK
72 Q
73WORK ;
74 S DATE1=0,DFN1=0
75 S DATE=BDT F S DATE=$O(^AUPNVHF("AED",DATE)) Q:DATE="" Q:DATE>(EDT+1) D
76 .S DFN="" F S DFN=$O(^AUPNVHF("AED",DATE,DFN)) Q:DFN="" D
77 ..I $D(TPAT) I TPAT=0 Q:$$TESTPAT^VADPT(DFN)
78 ..S COMPLETE=$$FIN(DATE,DFN),DONE=+COMPLETE,VDT=$P(COMPLETE,"^",2)
79 ..Q:FIN=1&(DONE=0)
80 ..Q:FIN=0&(DONE=1)
81 ..Q:'$$RANG(BDT,EDT,VDT,DATE,CHK)
82 ..;
83PAT ..;===Check Patient DFN to see if continue or quit
84 ..S DFNFLAG=1 I DFNONLY>0 D Q:DFNFLAG=0
85 ...I $D(DFNARY)&('$D(DFNARY(DFN))) S DFNFLAG=0
86 ...I '$D(DFNARY)&(DFN'=DFNONLY) S DFNFLAG=0
87 ...;======
88 ...;
89 ..S GEC="" F S GEC=$O(^AUPNVHF("AED",DATE,DFN,GEC)) Q:GEC="" D
90 ...Q:GEC'=GECFDA&(GEC'=GEC1DA)&(GEC'=GEC2DA)&(GEC'=GEC3DA)
91 ...S DFNXX=$P($G(^DPT(DFN,0)),"^",1)_" "_$P($G(^DPT(DFN,0)),"^",9)
92 ...S DATEY=$$FMTE^XLFDT(DATE,"1P")
93 ...I $D(^TMP("PXRMGEC",$J,"REF",DATE,DFN)) S ^TMP("PXRMGEC",$J,"REF",DATE,DFN)=$G(^TMP("PXRMGEC",$J,"REF",DATE,DFN))+1
94 ...E S ^TMP("PXRMGEC",$J,"REF",DATE,DFN)=1
95 ...;TO HERE BY REFERRAL
96 ...S DA="" F S DA=$O(^AUPNVHF("AED",DATE,DFN,GEC,DA)) Q:DA="" D
97 ....;TO HERE BY HEALTH FACTOR
98 ....D ARAYS
99 Q
100KILL ;Kill out unwanted Arrays
101 K ^TMP("PXRMGEC",$J,"REF"),^TMP("PXRMGEC",$J,"REFDFN")
102 Q
103ARAYS ;Set the Arrays for different reports
104 ;===============================================================
105 ;CHeck for new Referral
106 I DATE1'=DATE!(DFN1'=DFN) S CNTREF=CNTREF+1,DATE1=DATE,DFN1=DFN
107 ;===============================================================
108 I ARY="HS" D
109 .;CNTREF=Count or numbered Referral
110 .;DFN =Patient IEN
111 .;DATE =Starting Date of Referral
112 .;VDT =Finished Date of Referral-Visit of GECF
113 .;CAT =Health Factor Category
114 .;DATEV =Date that each Dialog was done
115 .;DA =Ien of each Health Factor
116 .;
117 .N NAMEDA,NAME,CATDA,CAT,DATEV,DATEDA,AGE,PXRMAPT,AGEF,SSN
118 .;
119 .;---AGE---
120 .D GETS^DIQ(2,DFN,.033,"ER","AGE")
121 .S AGE=AGE(2,DFN_",","AGE","E")
122 .S AGEF=0 I AGE>74 S AGEF=1
123 .;---SSN---"M3456"
124 .D GETS^DIQ(2,DFN,.0905,"ER","SSN")
125 .S SSN=SSN(2,DFN_",","1U4N","E")
126 .;---APPOINTMENTS---
127 .;DBIA #3859
128 .S PXRMAPT=0
129 .D GETAPPT^SDAMA201(DFN,"1","R",$$FMADD^XLFDT(VDT,-365,0,0,0),VDT,.PXRMAPT,"")
130 .I $D(^TMP($J,"SDAMA201","GETAPPT","ERROR")) S PXRMAPT=0
131 .K ^TMP($J,"SDAMA201","GETAPPT")
132 .;---APPOINTMENTS---
133 .S NAMEDA=$P($G(^AUPNVHF(DA,0)),"^",1)
134 .;GET COMMENTS
135 .S NAME=$P($G(^AUTTHF(NAMEDA,0)),"^",1)
136 .S DATEDA=$P($G(^AUPNVHF(DA,0)),"^",3)
137 .S DATEV=$P($G(^AUPNVSIT(DATEDA,0)),"^",1)
138 .S CATDA=$P($G(^AUTTHF(NAMEDA,0)),"^",3)
139 .S CAT=$P($G(^AUTTHF(CATDA,0)),"^",1)
140 .S ^TMP("PXRMGEC",$J,"GEC2",CNTREF,NAMEDA,AGEF,PXRMAPT,DFN,+$E($P(VDT,"."),4,5),SSN,VDT)=""
141 .K AGE
142 Q
143 ;
Note: See TracBrowser for help on using the repository browser.