Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMPDRS.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMPDRS.m
r613 r623 1 PXRMPDRS ;SLC/PKR - Patient List Demographic Report data selection. ;03/22/20072 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 4 ADDSEL( DATA,SUB);Let the user select the address information they want.5 6 S ADDLIST("A",1)=" 1 - CURRENT ADDRESS",DATA(SUB,1,1)="STREET ADDRESS #1"_U_17 S DATA(SUB,1,2)="STREET ADDRESS #2"_U_1,DATA(SUB,1,3)="STREET ADDRESS #3"_U_18 S DATA(SUB,1,4)="CITY"_U_1,DATA(SUB,1,5)="STATE"_U_2,DATA(SUB,1,6)="ZIP"_U_19 S DATA(SUB,1,7)="COUNTY"_U_210 S ADDLIST("A",2)=" 2 - PHONE NUMBER",DATA(SUB,2,8)="PHONE NUMBER"_U_111 12 13 14 15 16 S DATA(SUB)=LIST17 S DATA(SUB,"LEN")=$L(LIST,",")-118 19 20 APPERR 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 APPSEL( DATA,SUB);Let the user select the appointment information they want.47 48 49 50 51 52 S APPLIST("A",1)=" 1 - APPOINTMENT DATE",DATA(SUB,1,1)="APPOINTMENT DATE"_U_153 S APPLIST("A",2)=" 2 - CLINIC",DATA(SUB,2,2)="CLINIC"_U_254 55 56 57 58 59 S DATA(SUB)=LIST60 S DATA(SUB,"LEN")=$L(LIST,",")-161 I DATA(SUB,"LEN")=0 Q62 S DATA(SUB,"MAX")=$$ASKNUM^PXRMEUT("Maximum number of appointments to display",1,25)63 64 65 DATASEL(LISTIEN, DATA,SUB); Build a list of data that is availble for66 67 68 69 70 71 . S DATA(SUB,IND,IND)=DTYPE72 73 I IND=0 S DATA(SUB,"LEN")=0 Q74 75 76 77 78 79 S DATA(SUB)=LIST80 S DATA(SUB,"LEN")=$L(LIST,",")-181 82 83 DEMSEL(D ATA,SUB);Let the user select the demographic information they want.84 ;The first subscript ofDATA is the selection number and the85 86 87 88 89 S DEMLIST("A",1)=" 1 - SSN",DATA(SUB,1,2)="SSN"_U_290 S DEMLIST("A",2)=" 2 - DATE OF BIRTH",DATA(SUB,2,3)="DOB"_U_291 S DEMLIST("A",3)=" 3 - AGE",DATA(SUB,3,4)="AGE"_U_192 S DEMLIST("A",4)=" 4 - SEX",DATA(SUB,4,5)="SEX"_U_293 S DEMLIST("A",5)=" 5 - DATE OF DEATH",DATA(SUB,5,6)="DOD"_U_294 S DEMLIST("A",6)=" 6 - REMARKS",DATA(SUB,6,7)="REMARKS"_U_195 S DEMLIST("A",7)=" 7 - HISTORIC RACE",DATA(SUB,7,8)="HISTORIC RACE"_U_296 S DEMLIST("A",8)=" 8 - RELIGION",DATA(SUB,8,9)="RELIGION"_U_297 S DEMLIST("A",9)=" 9 - MARITAL STATUS",DATA(SUB,9,10)="MARTIAL STATUS"_U_298 S DEMLIST("A",10)="10 - ETHNICITY",DATA(SUB,10,11)="ETHNICITY"_U_299 S DEMLIST("A",11)="11 - RACE",DATA(SUB,11,12)="RACE"_U_2100 101 102 DSEL 103 104 105 S DATA(SUB)=LIST106 S DATA(SUB,"LEN")=$L(LIST,",")-1107 F IND=1:1:DATA(SUB,"LEN") D108 109 . S KND=$O(DATA(SUB,JND,""))110 . S TEMP=$P(DATA(SUB,JND,KND),U,1)111 112 113 114 .. S DATA(SUB,"FULLSSN")=$S($G(FULLSSN)="Y":1,1:0)115 . I $D(DTOUT)!$D(DUOUT) S IND=DATA(SUB,"LEN")+1 Q116 . I TEMP="ETHNICITY" S $P(DATA(SUB,10,11),U,3)=$$ASKNUM^PXRMEUT("Maximum number of ethnicity entries to display",1,10)117 . I TEMP="RACE" S $P(DATA(SUB,11,12),U,3)=$$ASKNUM^PXRMEUT("Maximum number of race entries to display",1,10)118 119 120 121 ELIGSEL( DATA,SUB);Let the user select the eligibility data they want.122 123 124 125 126 127 S ELIGLIST("A",1)=" 1 - PRIMARY ELGIBILITY CODE",DATA(SUB,1,1)="PRIMARY ELGIBILITY CODE"_U_2128 S ELIGLIST("A",2)=" 2 - PERIOD OF SERVICE",DATA(SUB,2,2)="PERIOD OF SERVICE"_U_2129 S ELIGLIST("A",3)=" 3 - % SERVICE CONNECTED",DATA(SUB,3,3)="% SERVICE CONNECTED"_U_2130 S ELIGLIST("A",4)=" 4 - VETERAN",DATA(SUB,4,4)="VETERAN"_U_1131 S ELIGLIST("A",5)=" 5 - TYPE",DATA(SUB,5,6)="TYPE"_U_2132 S ELIGLIST("A",6)=" 6 - ELIGIBILITY STATUS",DATA(SUB,6,8)="ELIGIBILITY STATUS"_U_2133 S ELIGLIST("A",7)=" 7 - CURRENT MEANS TEST",DATA(SUB,7,9)="CURRENT MEANS TEST"_U_2134 135 136 137 138 139 S DATA(SUB)=LIST140 S DATA(SUB,"LEN")=$L(LIST,",")-1141 142 143 HELP 144 145 146 147 148 149 INPSEL( DATA,SUB);Let the user select the inpatient information they want.150 151 152 153 154 155 S INPLIST("A",1)=" 1 - WARD LOCATION",DATA(SUB,1,4)="WARD"_U_2156 S INPLIST("A",2)=" 2 - ROOM-BED",DATA(SUB,2,5)="ROOM-BED"_U_1157 S INPLIST("A",3)=" 3 - ADMISSION DATE/TIME",DATA(SUB,3,7)="ADMISSION DATE/TIME"_U_2158 S INPLIST("A",4)=" 4 - ATTENDING PHYSICIAN",DATA(SUB,4,11)="ATTENDING"_U_2159 160 161 162 163 164 S DATA(SUB)=LIST165 S DATA(SUB,"LEN")=$L(LIST,",")-1166 167 168 REMSEL(PLIEN, DATA,SUB);If the list was generated from a reminder report169 170 I '$P(^PXRMXP(810.5,PLIEN,0),U,9) S DATA(SUB,"LEN")=0 Q171 172 173 174 175 176 177 . S DATA(SUB,"RNAME",IND)=RNAME178 . S DATA(SUB,"IEN",IND)=IEN179 180 181 182 183 184 185 S DATA(SUB)=LIST186 S DATA(SUB,"LEN")=$L(LIST,",")-1187 188 189 SEL(SELLIST,LEN) 190 191 192 193 194 195 1 PXRMPDRS ;SLC/PKR - Patient List Demographic Report data selection. ;07/18/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ; 4 ADDSEL(ADDDATA) ;Let the user select the address information they want. 5 N ADDLIST,LIST 6 S ADDLIST("A",1)=" 1 - CURRENT ADDRESS",ADDDATA(1,1)="STREET ADDRESS #1"_U_1 7 S ADDDATA(1,2)="STREET ADDRESS #2"_U_1,ADDDATA(1,3)="STREET ADDRESS #3"_U_1 8 S ADDDATA(1,4)="CITY"_U_1,ADDDATA(1,5)="STATE"_U_2,ADDDATA(1,6)="ZIP"_U_1 9 S ADDDATA(1,7)="COUNTY"_U_2 10 S ADDLIST("A",2)=" 2 - PHONE NUMBER",ADDDATA(2,8)="PHONE NUMBER"_U_1 11 S ADDLIST("A")="Enter your selection(s)" 12 S ADDLIST("?")="^D HELP^PXRMPDRS" 13 W !!,"Select from the following address items:" 14 S LIST=$$SEL^PXRMPDRS(.ADDLIST,2) 15 I $D(DTOUT)!$D(DUOUT) Q 16 S ADDDATA=LIST 17 S ADDDATA("LEN")=$L(LIST,",")-1 18 Q 19 ; 20 APPERR ; 21 N ECODE 22 I $D(ZTQUEUED) D Q 23 . N NL,TIME 24 . S TIME=$$NOW^XLFDT 25 . S TIME=$$FMTE^XLFDT(TIME) 26 . K ^TMP("PXRMXMZ",$J) 27 . S ^TMP("PXRMXMZ",$J,1,0)="The Patient Demographic Report requested by "_$$GET1^DIQ(200,DBDUZ,.01)_" on " 28 . S ^TMP("PXRMXMZ",$J,2,0)=TIME_" was supposed to include appointment data." 29 . S ^TMP("PXRMXMZ",$J,3,0)="Appointment data could not be obtained from the Scheduling database due to the" 30 . S ^TMP("PXRMXMZ",$J,4,0)="following error(s):" 31 . S ECODE=0,NL=4 32 . F S ECODE=$O(^TMP($J,"SDAMA301",ECODE)) Q:ECODE="" D 33 .. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" "_^TMP($J,"SDAMA301",ECODE) 34 . D SEND^PXRMMSG("Scheduling database error(s)",1) 35 . S ZTSTOP=1 36 ; 37 I '$D(ZTQUEUED) D Q 38 . W @IOF 39 . W !,"Appointment data could not be obtained from the Scheduling database due to the" 40 . W !,"following error(s):" 41 . S ECODE=0 42 . F S ECODE=$O(^TMP($J,"SDAMA301",ECODE)) Q:ECODE="" D 43 .. W !," ",^TMP($J,"SDAMA301",ECODE) 44 Q 45 ; 46 APPSEL(APPDATA) ;Let the user select the appointment information they want. 47 ;The first subscript of APPDATA is the selection number and the 48 ;the second subscript is the subscript where the data is returned 49 ;in VAPA. The first piece of APPDATA is the name of the data and the 50 ;second piece is the piece of VAPA this is displayed. 51 N APPLIST,LIST,MAX 52 S APPLIST("A",1)=" 1 - APPOINTMENT DATE",APPDATA(1,1)="APPOINTMENT DATE"_U_1 53 S APPLIST("A",2)=" 2 - CLINIC",APPDATA(2,2)="CLINIC"_U_2 54 S APPLIST("A")="Enter your selection(s)" 55 S APPLIST("?")="^D HELP^PXRMPDRS" 56 W !!,"Select from the following future appointment items:" 57 S LIST=$$SEL^PXRMPDRS(.APPLIST,2) 58 I $D(DTOUT)!$D(DUOUT) Q 59 S APPDATA=LIST 60 S APPDATA("LEN")=$L(LIST,",")-1 61 I APPDATA("LEN")=0 Q 62 S APPDATA("MAX")=$$ASKNUM^PXRMEUT("Maximum number of appointments to display",1,25) 63 Q 64 ; 65 DATASEL(LISTIEN,FINDDATA) ; Build a list of data that is availble for 66 ;this patient list and let the user select what they want. 67 N IND,DATALIST,DTYPE 68 S DTYPE="",IND=0 69 F S DTYPE=$O(^PXRMXP(810.5,LISTIEN,35,"B",DTYPE)) Q:DTYPE="" D 70 . S IND=IND+1,DATALIST("A",IND)=" "_IND_" - "_DTYPE 71 . S FINDDATA(IND,IND)=DTYPE 72 ;If there is no data quit. 73 I IND=0 S FINDDATA("LEN")=0 Q 74 S DATALIST("A")="Enter your selections(s)" 75 S DATALIST("?")="^D HELP^PXRMPDRS" 76 W !!,"Select from the following patient data:" 77 S LIST=$$SEL^PXRMPDRS(.DATALIST,IND) 78 I $D(DTOUT)!$D(DUOUT) Q 79 S FINDDATA=LIST 80 S FINDDATA("LEN")=$L(LIST,",")-1 81 Q 82 ; 83 DEMSEL(DEMDATA) ;Let the user select the demographic information they want. 84 ;The first subscript of DEMDATA is the selection number and the 85 ;the second subscript is the subscript where the data is returned 86 ;in VADM. The first piece of DEMDATA is the name of the data and the 87 ;second piece is the piece of VADM this is displayed. 88 N DEMLIST,DTOUT,DUOUT,IND,ITEM,JND,KND,LIST,TEMP 89 S DEMLIST("A",1)=" 1 - SSN",DEMDATA(1,2)="SSN"_U_2 90 S DEMLIST("A",2)=" 2 - DATE OF BIRTH",DEMDATA(2,3)="DOB"_U_2 91 S DEMLIST("A",3)=" 3 - AGE",DEMDATA(3,4)="AGE"_U_1 92 S DEMLIST("A",4)=" 4 - SEX",DEMDATA(4,5)="SEX"_U_2 93 S DEMLIST("A",5)=" 5 - DATE OF DEATH",DEMDATA(5,6)="DOD"_U_2 94 S DEMLIST("A",6)=" 6 - REMARKS",DEMDATA(6,7)="REMARKS"_U_1 95 S DEMLIST("A",7)=" 7 - HISTORIC RACE",DEMDATA(7,8)="HISTORIC RACE"_U_2 96 S DEMLIST("A",8)=" 8 - RELIGION",DEMDATA(8,9)="RELIGION"_U_2 97 S DEMLIST("A",9)=" 9 - MARITAL STATUS",DEMDATA(9,10)="MARTIAL STATUS"_U_2 98 S DEMLIST("A",10)="10 - ETHNICITY",DEMDATA(10,11)="ETHNICITY"_U_2 99 S DEMLIST("A",11)="11 - RACE",DEMDATA(11,12)="RACE"_U_2 100 S DEMLIST("A")="Enter your selection(s)" 101 S DEMLIST("?")="^D HELP^PXRMPDRS" 102 DSEL W !!,"Select from the following demographic items:" 103 S LIST=$$SEL^PXRMPDRS(.DEMLIST,11) 104 I $D(DTOUT)!$D(DUOUT) Q 105 S DEMDATA=LIST 106 S DEMDATA("LEN")=$L(LIST,",")-1 107 F IND=1:1:DEMDATA("LEN") D 108 . S JND=$P(LIST,",",IND) 109 . S KND=$O(DEMDATA(JND,"")) 110 . S TEMP=$P(DEMDATA(JND,KND),U,1) 111 . I TEMP="SSN" D 112 .. N FULLSSN 113 .. D SSN^PXRMXSD(.FULLSSN) 114 .. S DEMDATA("FULLSSN")=$S($G(FULLSSN)="Y":1,1:0) 115 . I $D(DTOUT)!$D(DUOUT) S IND=DEMDATA("LEN")+1 Q 116 . I TEMP="ETHNICITY" S $P(DEMDATA(10,11),U,3)=$$ASKNUM^PXRMEUT("Maximum number of ethnicity entries to display",1,10) 117 . I TEMP="RACE" S $P(DEMDATA(11,12),U,3)=$$ASKNUM^PXRMEUT("Maximum number of race entries to display",1,10) 118 I $D(DTOUT)!$D(DUOUT) K DTOUT,DUOUT G DSEL 119 Q 120 ; 121 ELIGSEL(ELIGDATA) ;Let the user select the eligibility data they want. 122 ;The first subscript of ELIGDATA is the selection number and the 123 ;the second subscript is the subscript where the data is returned 124 ;in VAEL. The first piece of ELIGDATA is the name of the data and the 125 ;second piece is the piece of VAEL this is displayed. 126 N ELIGLIST,ITEM,LIST 127 S ELIGLIST("A",1)=" 1 - PRIMARY ELGIBILITY CODE",ELIGDATA(1,1)="PRIMARY ELGIBILITY CODE"_U_2 128 S ELIGLIST("A",2)=" 2 - PERIOD OF SERVICE",ELIGDATA(2,2)="PERIOD OF SERVICE"_U_2 129 S ELIGLIST("A",3)=" 3 - % SERVICE CONNECTED",ELIGDATA(3,3)="% SERVICE CONNECTED"_U_2 130 S ELIGLIST("A",4)=" 4 - VETERAN",ELIGDATA(4,4)="VETERAN"_U_1 131 S ELIGLIST("A",5)=" 5 - TYPE",ELIGDATA(5,6)="TYPE"_U_2 132 S ELIGLIST("A",6)=" 6 - ELIGIBILITY STATUS",ELIGDATA(6,8)="ELIGIBILITY STATUS"_U_2 133 S ELIGLIST("A",7)=" 7 - CURRENT MEANS TEST",ELIGDATA(7,9)="CURRENT MEANS TEST"_U_2 134 S ELIGLIST("A")="Enter your selection(s)" 135 S ELIGLIST("?")="^D HELP^PXRMPDRS" 136 W !!,"Select from the following eligibility items:" 137 S LIST=$$SEL^PXRMPDRS(.ELIGLIST,7) 138 I $D(DTOUT)!$D(DUOUT) Q 139 S ELIGDATA=LIST 140 S ELIGDATA("LEN")=$L(LIST,",")-1 141 Q 142 ; 143 HELP ; -- help code. 144 W !!,"You can choose any combination of numbers i.e., 1-4 or 1,3-5" 145 W !!,"See the Clinical Reminders Managers manual for detailed explanations of each" 146 W !,"of the selection items." 147 Q 148 ; 149 INPSEL(INPDATA) ;Let the user select the inpatient information they want. 150 ;The first subscript of INPDATA is the selection number and the 151 ;the second subscript is the subscript where the data is returned 152 ;in VAIN. The first piece of INPDATA is the name of the data and the 153 ;second piece is the piece of VAIN this is displayed. 154 N INPLIST,ITEM,LIST 155 S INPLIST("A",1)=" 1 - WARD LOCATION",INPDATA(1,4)="WARD"_U_2 156 S INPLIST("A",2)=" 2 - ROOM-BED",INPDATA(2,5)="ROOM-BED"_U_1 157 S INPLIST("A",3)=" 3 - ADMISSION DATE/TIME",INPDATA(3,7)="ADMISSION DATE/TIME"_U_2 158 S INPLIST("A",4)=" 4 - ATTENDING PHYSICIAN",INPDATA(4,11)="ATTENDING"_U_2 159 S INPLIST("A")="Enter your selection(s)" 160 S INPLIST("?")="^D HELP^PXRMPDRS" 161 W !!,"Select from the following inpatient items:" 162 S LIST=$$SEL^PXRMPDRS(.INPLIST,5) 163 I $D(DTOUT)!$D(DUOUT) Q 164 S INPDATA=LIST 165 S INPDATA("LEN")=$L(LIST,",")-1 166 Q 167 ; 168 REMSEL(PLIEN,REMDATA) ;If the list was generated from a reminder report 169 ;let the user select the reminder data they want. 170 I '$P(^PXRMXP(810.5,PLIEN,0),U,9) S REMDATA("LEN")=0 Q 171 N IEN,IND,REMLIST,RNAME 172 S (IEN,IND)=0 173 F S IEN=$O(^PXRMXP(810.5,PLIEN,45,"B",IEN)) Q:IEN="" D 174 . S RNAME=$P(^PXD(811.9,IEN,0),U,3) 175 . I RNAME="" S RNAME=$P(^PXD(811.9,IEN,0),U,1) 176 . S IND=IND+1 177 . S REMDATA("RNAME",IND)=RNAME 178 . S REMDATA("IEN",IND)=IEN 179 . S REMLIST("A",IND)=" "_IND_" - "_RNAME 180 S REMLIST("A")="Enter your selection(s)" 181 S REMLIST("?")="^D HELP^PXRMPDRS" 182 W !!,"Include due status information for the following reminder(s):" 183 S LIST=$$SEL^PXRMPDRS(.REMLIST,IND) 184 I $D(DTOUT)!$D(DUOUT) Q 185 S REMDATA=LIST 186 S REMDATA("LEN")=$L(LIST,",")-1 187 Q 188 ; 189 SEL(SELLIST,LEN) ;Select global list 190 N DIR,X,Y 191 M DIR=SELLIST 192 S DIR(0)="LO^1:"_LEN 193 D ^DIR 194 Q Y 195 ;
Note:
See TracChangeset
for help on using the changeset viewer.
