[623] | 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 | ;
|
---|