- PXRMPDRS ;SLC/PKR - Patient List Demographic Report data selection. ;03/03/2011
- ;;2.0;CLINICAL REMINDERS;**4,6,12,17,18**;Feb 04, 2005;Build 152
- ;==========================================================
- ADDSEL(DATA,SUB) ;Let the user select the address information they want.
- N ADDLIST,LIST
- S ADDLIST("A",1)=" 1 - CURRENT ADDRESS",DATA(SUB,1,1)="STREET ADDRESS #1"_U_1
- S DATA(SUB,1,2)="STREET ADDRESS #2"_U_1,DATA(SUB,1,3)="STREET ADDRESS #3"_U_1
- S DATA(SUB,1,4)="CITY"_U_1,DATA(SUB,1,5)="STATE"_U_2,DATA(SUB,1,6)="ZIP"_U_1
- S DATA(SUB,1,7)="COUNTY"_U_2
- S DATA(SUB,1,23)="ADD TYPE"_U_1
- S ADDLIST("A",2)=" 2 - PHONE NUMBER",DATA(SUB,2,8)="PHONE NUMBER"_U_1
- S ADDLIST("A")="Enter your selection(s)"
- S ADDLIST("?")="^D HELP^PXRMPDRS"
- W !!,"Select from the following address items:"
- S LIST=$$SEL^PXRMPDRS(.ADDLIST,2)
- I $D(DTOUT)!$D(DUOUT) Q
- S DATA(SUB)=LIST
- S DATA(SUB,"LEN")=$L(LIST,",")-1
- I DATA(SUB)["1," D GCATYPE(.DATA,SUB)
- Q
- ;
- ;==========================================================
- APPERR ;
- N ECODE
- I $D(ZTQUEUED) D Q
- . N MGIEN,MGROUP,NL,TIME,TO
- . S TIME=$$NOW^XLFDT
- . S TIME=$$FMTE^XLFDT(TIME)
- . K ^TMP("PXRMXMZ",$J)
- . S ^TMP("PXRMXMZ",$J,1,0)="The Patient Demographic Report requested by "_$$GET1^DIQ(200,DBDUZ,.01)_" on "
- . S ^TMP("PXRMXMZ",$J,2,0)=TIME_" was supposed to include appointment data."
- . S ^TMP("PXRMXMZ",$J,3,0)="Appointment data could not be obtained from the Scheduling database due to the"
- . S ^TMP("PXRMXMZ",$J,4,0)="following error(s):"
- . S ECODE=0,NL=4
- . F S ECODE=$O(^TMP($J,"SDAMA301",ECODE)) Q:ECODE="" D
- .. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" "_^TMP($J,"SDAMA301",ECODE)
- . S TO(DBDUZ)=""
- . S MGIEN=$G(^PXRM(800,1,"MGFE"))
- . I MGIEN'="" D
- .. S MGROUP="G."_$$GET1^DIQ(3.8,MGIEN,.01)
- .. S TO(MGROUP)=""
- . D SEND^PXRMMSG("PXRMXMZ","Scheduling database error(s)",.TO,DUZ)
- . S ZTSTOP=1
- ;
- I '$D(ZTQUEUED) D Q
- . W @IOF
- . W !,"Appointment data could not be obtained from the Scheduling database due to the"
- . W !,"following error(s):"
- . S ECODE=0
- . F S ECODE=$O(^TMP($J,"SDAMA301",ECODE)) Q:ECODE="" D
- .. W !," ",^TMP($J,"SDAMA301",ECODE)
- Q
- ;
- ;==========================================================
- APPSEL(DATA,SUB) ;Let the user select the appointment information they want.
- ;The first subscript of APPDATA is the selection number and the
- ;the second subscript is the subscript where the data is returned
- ;in VAPA. The first piece of APPDATA is the name of the data and the
- ;second piece is the piece of VAPA this is displayed.
- N APPLIST,LIST,MAX
- S APPLIST("A",1)=" 1 - APPOINTMENT DATE",DATA(SUB,1,1)="APPOINTMENT DATE"_U_1
- S APPLIST("A",2)=" 2 - CLINIC",DATA(SUB,2,2)="CLINIC"_U_2
- S APPLIST("A")="Enter your selection(s)"
- S APPLIST("?")="^D HELP^PXRMPDRS"
- W !!,"Select from the following future appointment items:"
- S LIST=$$SEL^PXRMPDRS(.APPLIST,2)
- I $D(DTOUT)!$D(DUOUT) Q
- S DATA(SUB)=LIST
- S DATA(SUB,"LEN")=$L(LIST,",")-1
- I DATA(SUB,"LEN")=0 Q
- S DATA(SUB,"MAX")=$$ASKNUM^PXRMEUT("Maximum number of appointments to display",1,25)
- Q
- ;
- ;==========================================================
- DATASEL(LISTIEN,DATA,SUB) ; Build a list of data that is availble for
- ;this patient list and let the user select what they want.
- N IND,DATALIST,DTYPE
- S DTYPE="",IND=0
- F S DTYPE=$O(^PXRMXP(810.5,LISTIEN,35,"B",DTYPE)) Q:DTYPE="" D
- . S IND=IND+1,DATALIST("A",IND)=" "_IND_" - "_DTYPE
- . S DATA(SUB,IND,IND)=DTYPE
- ;If there is no data quit.
- I IND=0 S DATA(SUB,"LEN")=0 Q
- S DATALIST("A")="Enter your selections(s)"
- S DATALIST("?")="^D HELP^PXRMPDRS"
- W !!,"Select from the following patient data:"
- S LIST=$$SEL^PXRMPDRS(.DATALIST,IND)
- I $D(DTOUT)!$D(DUOUT) Q
- S DATA(SUB)=LIST
- S DATA(SUB,"LEN")=$L(LIST,",")-1
- Q
- ;
- ;==========================================================
- DEMSEL(DATA,SUB) ;Let the user select the demographic information they want.
- ;The second subscript of DATA is the selection number and the
- ;the third subscript is the subscript where the data is returned
- ;in VADM by VADPT. The first piece of DEMDATA is the name of the data
- ;and the second piece is the piece of VADM this is displayed.
- N DEMLIST,DTOUT,DUOUT,IND,ITEM,JND,KND,LIST,TEMP
- S DEMLIST("A",1)=" 1 - SSN",DATA(SUB,1,2)="SSN"_U_2
- S DEMLIST("A",2)=" 2 - DATE OF BIRTH",DATA(SUB,2,3)="DOB"_U_2
- S DEMLIST("A",3)=" 3 - AGE",DATA(SUB,3,4)="AGE"_U_1
- S DEMLIST("A",4)=" 4 - SEX",DATA(SUB,4,5)="SEX"_U_2
- S DEMLIST("A",5)=" 5 - DATE OF DEATH",DATA(SUB,5,6)="DOD"_U_2
- S DEMLIST("A",6)=" 6 - REMARKS",DATA(SUB,6,7)="REMARKS"_U_1
- S DEMLIST("A",7)=" 7 - HISTORIC RACE",DATA(SUB,7,8)="HISTORIC RACE"_U_2
- S DEMLIST("A",8)=" 8 - RELIGION",DATA(SUB,8,9)="RELIGION"_U_2
- S DEMLIST("A",9)=" 9 - MARITAL STATUS",DATA(SUB,9,10)="MARTIAL STATUS"_U_2
- S DEMLIST("A",10)="10 - ETHNICITY",DATA(SUB,10,11)="ETHNICITY"_U_2
- S DEMLIST("A",11)="11 - RACE",DATA(SUB,11,12)="RACE"_U_2
- S DEMLIST("A")="Enter your selection(s)"
- S DEMLIST("?")="^D HELP^PXRMPDRS"
- DSEL W !!,"Select from the following demographic items:"
- S LIST=$$SEL^PXRMPDRS(.DEMLIST,11)
- I $D(DTOUT)!$D(DUOUT) Q
- S DATA(SUB)=LIST
- S DATA(SUB,"LEN")=$L(LIST,",")-1
- F IND=1:1:DATA(SUB,"LEN") D
- . S JND=$P(LIST,",",IND)
- . S KND=$O(DATA(SUB,JND,""))
- . S TEMP=$P(DATA(SUB,JND,KND),U,1)
- . I TEMP="SSN" D
- .. N FULLSSN
- .. D SSN^PXRMXSD(.FULLSSN)
- .. S DATA(SUB,"FULLSSN")=$S($G(FULLSSN)="Y":1,1:0)
- . I $D(DTOUT)!$D(DUOUT) S IND=DATA(SUB,"LEN")+1 Q
- . I TEMP="ETHNICITY" S $P(DATA(SUB,10,11),U,3)=$$ASKNUM^PXRMEUT("Maximum number of ethnicity entries to display",1,10)
- . I TEMP="RACE" S $P(DATA(SUB,11,12),U,3)=$$ASKNUM^PXRMEUT("Maximum number of race entries to display",1,10)
- I $D(DTOUT)!$D(DUOUT) K DTOUT,DUOUT G DSEL
- Q
- ;
- ;==========================================================
- ELIGSEL(DATA,SUB) ;Let the user select the eligibility data they want.
- ;The first subscript of ELIGDATA is the selection number and the
- ;the second subscript is the subscript where the data is returned
- ;in VAEL. The first piece of ELIGDATA is the name of the data and the
- ;second piece is the piece of VAEL this is displayed.
- N ELIGLIST,ITEM,LIST
- S ELIGLIST("A",1)=" 1 - PRIMARY ELGIBILITY CODE",DATA(SUB,1,1)="PRIMARY ELGIBILITY CODE"_U_2
- S ELIGLIST("A",2)=" 2 - PERIOD OF SERVICE",DATA(SUB,2,2)="PERIOD OF SERVICE"_U_2
- S ELIGLIST("A",3)=" 3 - % SERVICE CONNECTED",DATA(SUB,3,3)="% SERVICE CONNECTED"_U_2
- S ELIGLIST("A",4)=" 4 - VETERAN",DATA(SUB,4,4)="VETERAN"_U_1
- S ELIGLIST("A",5)=" 5 - TYPE",DATA(SUB,5,6)="TYPE"_U_2
- S ELIGLIST("A",6)=" 6 - ELIGIBILITY STATUS",DATA(SUB,6,8)="ELIGIBILITY STATUS"_U_2
- S ELIGLIST("A",7)=" 7 - CURRENT MEANS TEST",DATA(SUB,7,9)="CURRENT MEANS TEST"_U_2
- S ELIGLIST("A")="Enter your selection(s)"
- S ELIGLIST("?")="^D HELP^PXRMPDRS"
- W !!,"Select from the following eligibility items:"
- S LIST=$$SEL^PXRMPDRS(.ELIGLIST,7)
- I $D(DTOUT)!$D(DUOUT) Q
- S DATA(SUB)=LIST
- S DATA(SUB,"LEN")=$L(LIST,",")-1
- Q
- ;
- ;==========================================================
- GCATYPE(DATA,SUB) ;Get the type of confidential addresses to use.
- N CATLIST,IND,JND,LIST,MSG
- D HELP^DIE(2.141,"",.01,"S","MSG")
- W !!,"If the patient has an active confidential address, which of the following"
- W !,"confidential address categories are appropriate to use?",!
- S CATLIST("A")="If no selection is made the default is 2 and 4, enter your selection(s)"
- S JND=0
- F IND=2:1:MSG("DIHELP") D
- . S JND=JND+1
- . S CATLIST("A",JND)=" "_MSG("DIHELP",IND)
- S LIST=$$SEL^PXRMPDRS(.CATLIST,JND)
- I LIST="" S LIST="2,4,"
- S DATA(SUB,22,"LEN")=$L(LIST,",")-1
- S DATA(SUB,22,"LIST")=LIST
- Q
- ;
- ;==========================================================
- HELP ; -- help code.
- W !!,"You can choose any combination of numbers i.e., 1-4 or 1,3-5"
- W !!,"See the Clinical Reminders Managers manual for detailed explanations of each"
- W !,"of the selection items."
- Q
- ;
- ;==========================================================
- INPSEL(DATA,SUB) ;Let the user select the inpatient information they want.
- ;The first subscript of INPDATA is the selection number and the
- ;the second subscript is the subscript where the data is returned
- ;in VAIN. The first piece of INPDATA is the name of the data and the
- ;second piece is the piece of VAIN this is displayed.
- N INPLIST,ITEM,LIST
- S INPLIST("A",1)=" 1 - WARD LOCATION",DATA(SUB,1,4)="WARD"_U_2
- S INPLIST("A",2)=" 2 - ROOM-BED",DATA(SUB,2,5)="ROOM-BED"_U_1
- S INPLIST("A",3)=" 3 - ADMISSION DATE/TIME",DATA(SUB,3,7)="ADMISSION DATE/TIME"_U_2
- S INPLIST("A",4)=" 4 - ATTENDING PHYSICIAN",DATA(SUB,4,11)="ATTENDING"_U_2
- S INPLIST("A")="Enter your selection(s)"
- S INPLIST("?")="^D HELP^PXRMPDRS"
- W !!,"Select from the following inpatient items:"
- S LIST=$$SEL^PXRMPDRS(.INPLIST,4)
- I $D(DTOUT)!$D(DUOUT) Q
- S DATA(SUB)=LIST
- S DATA(SUB,"LEN")=$L(LIST,",")-1
- Q
- ;
- ;==========================================================
- REMSEL(PLIEN,DATA,SUB) ;If the list was generated from a reminder report
- ;let the user select the reminder data they want.
- I '$P(^PXRMXP(810.5,PLIEN,0),U,9) S DATA(SUB,"LEN")=0 Q
- N IEN,IND,REMLIST,RNAME
- S (IEN,IND)=0
- F S IEN=$O(^PXRMXP(810.5,PLIEN,45,"B",IEN)) Q:IEN="" D
- . S RNAME=$P(^PXD(811.9,IEN,0),U,3)
- . I RNAME="" S RNAME=$P(^PXD(811.9,IEN,0),U,1)
- . S IND=IND+1
- . S DATA(SUB,"RNAME",IND)=RNAME
- . S DATA(SUB,"IEN",IND)=IEN
- . S REMLIST("A",IND)=" "_IND_" - "_RNAME
- S REMLIST("A")="Enter your selection(s)"
- S REMLIST("?")="^D HELP^PXRMPDRS"
- W !!,"Include due status information for the following reminder(s):"
- S LIST=$$SEL^PXRMPDRS(.REMLIST,IND)
- I $D(DTOUT)!$D(DUOUT) Q
- S DATA(SUB)=LIST
- S DATA(SUB,"LEN")=$L(LIST,",")-1
- Q
- ;
- ;==========================================================
- SEL(SELLIST,LEN) ;Select global list
- N DIR,X,Y
- M DIR=SELLIST
- S DIR(0)="LO^1:"_LEN
- D ^DIR
- Q Y
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMPDRS 9966 printed Feb 18, 2025@23:14:52 Page 2
- PXRMPDRS ;SLC/PKR - Patient List Demographic Report data selection. ;03/03/2011
- +1 ;;2.0;CLINICAL REMINDERS;**4,6,12,17,18**;Feb 04, 2005;Build 152
- +2 ;==========================================================
- ADDSEL(DATA,SUB) ;Let the user select the address information they want.
- +1 NEW ADDLIST,LIST
- +2 SET ADDLIST("A",1)=" 1 - CURRENT ADDRESS"
- SET DATA(SUB,1,1)="STREET ADDRESS #1"_U_1
- +3 SET DATA(SUB,1,2)="STREET ADDRESS #2"_U_1
- SET DATA(SUB,1,3)="STREET ADDRESS #3"_U_1
- +4 SET DATA(SUB,1,4)="CITY"_U_1
- SET DATA(SUB,1,5)="STATE"_U_2
- SET DATA(SUB,1,6)="ZIP"_U_1
- +5 SET DATA(SUB,1,7)="COUNTY"_U_2
- +6 SET DATA(SUB,1,23)="ADD TYPE"_U_1
- +7 SET ADDLIST("A",2)=" 2 - PHONE NUMBER"
- SET DATA(SUB,2,8)="PHONE NUMBER"_U_1
- +8 SET ADDLIST("A")="Enter your selection(s)"
- +9 SET ADDLIST("?")="^D HELP^PXRMPDRS"
- +10 WRITE !!,"Select from the following address items:"
- +11 SET LIST=$$SEL^PXRMPDRS(.ADDLIST,2)
- +12 IF $DATA(DTOUT)!$DATA(DUOUT)
- QUIT
- +13 SET DATA(SUB)=LIST
- +14 SET DATA(SUB,"LEN")=$LENGTH(LIST,",")-1
- +15 IF DATA(SUB)["1,"
- DO GCATYPE(.DATA,SUB)
- +16 QUIT
- +17 ;
- +18 ;==========================================================
- APPERR ;
- +1 NEW ECODE
- +2 IF $DATA(ZTQUEUED)
- Begin DoDot:1
- +3 NEW MGIEN,MGROUP,NL,TIME,TO
- +4 SET TIME=$$NOW^XLFDT
- +5 SET TIME=$$FMTE^XLFDT(TIME)
- +6 KILL ^TMP("PXRMXMZ",$JOB)
- +7 SET ^TMP("PXRMXMZ",$JOB,1,0)="The Patient Demographic Report requested by "_$$GET1^DIQ(200,DBDUZ,.01)_" on "
- +8 SET ^TMP("PXRMXMZ",$JOB,2,0)=TIME_" was supposed to include appointment data."
- +9 SET ^TMP("PXRMXMZ",$JOB,3,0)="Appointment data could not be obtained from the Scheduling database due to the"
- +10 SET ^TMP("PXRMXMZ",$JOB,4,0)="following error(s):"
- +11 SET ECODE=0
- SET NL=4
- +12 FOR
- SET ECODE=$ORDER(^TMP($JOB,"SDAMA301",ECODE))
- if ECODE=""
- QUIT
- Begin DoDot:2
- +13 SET NL=NL+1
- SET ^TMP("PXRMXMZ",$JOB,NL,0)=" "_^TMP($JOB,"SDAMA301",ECODE)
- End DoDot:2
- +14 SET TO(DBDUZ)=""
- +15 SET MGIEN=$GET(^PXRM(800,1,"MGFE"))
- +16 IF MGIEN'=""
- Begin DoDot:2
- +17 SET MGROUP="G."_$$GET1^DIQ(3.8,MGIEN,.01)
- +18 SET TO(MGROUP)=""
- End DoDot:2
- +19 DO SEND^PXRMMSG("PXRMXMZ","Scheduling database error(s)",.TO,DUZ)
- +20 SET ZTSTOP=1
- End DoDot:1
- QUIT
- +21 ;
- +22 IF '$DATA(ZTQUEUED)
- Begin DoDot:1
- +23 WRITE @IOF
- +24 WRITE !,"Appointment data could not be obtained from the Scheduling database due to the"
- +25 WRITE !,"following error(s):"
- +26 SET ECODE=0
- +27 FOR
- SET ECODE=$ORDER(^TMP($JOB,"SDAMA301",ECODE))
- if ECODE=""
- QUIT
- Begin DoDot:2
- +28 WRITE !," ",^TMP($JOB,"SDAMA301",ECODE)
- End DoDot:2
- End DoDot:1
- QUIT
- +29 QUIT
- +30 ;
- +31 ;==========================================================
- APPSEL(DATA,SUB) ;Let the user select the appointment information they want.
- +1 ;The first subscript of APPDATA is the selection number and the
- +2 ;the second subscript is the subscript where the data is returned
- +3 ;in VAPA. The first piece of APPDATA is the name of the data and the
- +4 ;second piece is the piece of VAPA this is displayed.
- +5 NEW APPLIST,LIST,MAX
- +6 SET APPLIST("A",1)=" 1 - APPOINTMENT DATE"
- SET DATA(SUB,1,1)="APPOINTMENT DATE"_U_1
- +7 SET APPLIST("A",2)=" 2 - CLINIC"
- SET DATA(SUB,2,2)="CLINIC"_U_2
- +8 SET APPLIST("A")="Enter your selection(s)"
- +9 SET APPLIST("?")="^D HELP^PXRMPDRS"
- +10 WRITE !!,"Select from the following future appointment items:"
- +11 SET LIST=$$SEL^PXRMPDRS(.APPLIST,2)
- +12 IF $DATA(DTOUT)!$DATA(DUOUT)
- QUIT
- +13 SET DATA(SUB)=LIST
- +14 SET DATA(SUB,"LEN")=$LENGTH(LIST,",")-1
- +15 IF DATA(SUB,"LEN")=0
- QUIT
- +16 SET DATA(SUB,"MAX")=$$ASKNUM^PXRMEUT("Maximum number of appointments to display",1,25)
- +17 QUIT
- +18 ;
- +19 ;==========================================================
- DATASEL(LISTIEN,DATA,SUB) ; Build a list of data that is availble for
- +1 ;this patient list and let the user select what they want.
- +2 NEW IND,DATALIST,DTYPE
- +3 SET DTYPE=""
- SET IND=0
- +4 FOR
- SET DTYPE=$ORDER(^PXRMXP(810.5,LISTIEN,35,"B",DTYPE))
- if DTYPE=""
- QUIT
- Begin DoDot:1
- +5 SET IND=IND+1
- SET DATALIST("A",IND)=" "_IND_" - "_DTYPE
- +6 SET DATA(SUB,IND,IND)=DTYPE
- End DoDot:1
- +7 ;If there is no data quit.
- +8 IF IND=0
- SET DATA(SUB,"LEN")=0
- QUIT
- +9 SET DATALIST("A")="Enter your selections(s)"
- +10 SET DATALIST("?")="^D HELP^PXRMPDRS"
- +11 WRITE !!,"Select from the following patient data:"
- +12 SET LIST=$$SEL^PXRMPDRS(.DATALIST,IND)
- +13 IF $DATA(DTOUT)!$DATA(DUOUT)
- QUIT
- +14 SET DATA(SUB)=LIST
- +15 SET DATA(SUB,"LEN")=$LENGTH(LIST,",")-1
- +16 QUIT
- +17 ;
- +18 ;==========================================================
- DEMSEL(DATA,SUB) ;Let the user select the demographic information they want.
- +1 ;The second subscript of DATA is the selection number and the
- +2 ;the third subscript is the subscript where the data is returned
- +3 ;in VADM by VADPT. The first piece of DEMDATA is the name of the data
- +4 ;and the second piece is the piece of VADM this is displayed.
- +5 NEW DEMLIST,DTOUT,DUOUT,IND,ITEM,JND,KND,LIST,TEMP
- +6 SET DEMLIST("A",1)=" 1 - SSN"
- SET DATA(SUB,1,2)="SSN"_U_2
- +7 SET DEMLIST("A",2)=" 2 - DATE OF BIRTH"
- SET DATA(SUB,2,3)="DOB"_U_2
- +8 SET DEMLIST("A",3)=" 3 - AGE"
- SET DATA(SUB,3,4)="AGE"_U_1
- +9 SET DEMLIST("A",4)=" 4 - SEX"
- SET DATA(SUB,4,5)="SEX"_U_2
- +10 SET DEMLIST("A",5)=" 5 - DATE OF DEATH"
- SET DATA(SUB,5,6)="DOD"_U_2
- +11 SET DEMLIST("A",6)=" 6 - REMARKS"
- SET DATA(SUB,6,7)="REMARKS"_U_1
- +12 SET DEMLIST("A",7)=" 7 - HISTORIC RACE"
- SET DATA(SUB,7,8)="HISTORIC RACE"_U_2
- +13 SET DEMLIST("A",8)=" 8 - RELIGION"
- SET DATA(SUB,8,9)="RELIGION"_U_2
- +14 SET DEMLIST("A",9)=" 9 - MARITAL STATUS"
- SET DATA(SUB,9,10)="MARTIAL STATUS"_U_2
- +15 SET DEMLIST("A",10)="10 - ETHNICITY"
- SET DATA(SUB,10,11)="ETHNICITY"_U_2
- +16 SET DEMLIST("A",11)="11 - RACE"
- SET DATA(SUB,11,12)="RACE"_U_2
- +17 SET DEMLIST("A")="Enter your selection(s)"
- +18 SET DEMLIST("?")="^D HELP^PXRMPDRS"
- DSEL WRITE !!,"Select from the following demographic items:"
- +1 SET LIST=$$SEL^PXRMPDRS(.DEMLIST,11)
- +2 IF $DATA(DTOUT)!$DATA(DUOUT)
- QUIT
- +3 SET DATA(SUB)=LIST
- +4 SET DATA(SUB,"LEN")=$LENGTH(LIST,",")-1
- +5 FOR IND=1:1:DATA(SUB,"LEN")
- Begin DoDot:1
- +6 SET JND=$PIECE(LIST,",",IND)
- +7 SET KND=$ORDER(DATA(SUB,JND,""))
- +8 SET TEMP=$PIECE(DATA(SUB,JND,KND),U,1)
- +9 IF TEMP="SSN"
- Begin DoDot:2
- +10 NEW FULLSSN
- +11 DO SSN^PXRMXSD(.FULLSSN)
- +12 SET DATA(SUB,"FULLSSN")=$SELECT($GET(FULLSSN)="Y":1,1:0)
- End DoDot:2
- +13 IF $DATA(DTOUT)!$DATA(DUOUT)
- SET IND=DATA(SUB,"LEN")+1
- QUIT
- +14 IF TEMP="ETHNICITY"
- SET $PIECE(DATA(SUB,10,11),U,3)=$$ASKNUM^PXRMEUT("Maximum number of ethnicity entries to display",1,10)
- +15 IF TEMP="RACE"
- SET $PIECE(DATA(SUB,11,12),U,3)=$$ASKNUM^PXRMEUT("Maximum number of race entries to display",1,10)
- End DoDot:1
- +16 IF $DATA(DTOUT)!$DATA(DUOUT)
- KILL DTOUT,DUOUT
- GOTO DSEL
- +17 QUIT
- +18 ;
- +19 ;==========================================================
- ELIGSEL(DATA,SUB) ;Let the user select the eligibility data they want.
- +1 ;The first subscript of ELIGDATA is the selection number and the
- +2 ;the second subscript is the subscript where the data is returned
- +3 ;in VAEL. The first piece of ELIGDATA is the name of the data and the
- +4 ;second piece is the piece of VAEL this is displayed.
- +5 NEW ELIGLIST,ITEM,LIST
- +6 SET ELIGLIST("A",1)=" 1 - PRIMARY ELGIBILITY CODE"
- SET DATA(SUB,1,1)="PRIMARY ELGIBILITY CODE"_U_2
- +7 SET ELIGLIST("A",2)=" 2 - PERIOD OF SERVICE"
- SET DATA(SUB,2,2)="PERIOD OF SERVICE"_U_2
- +8 SET ELIGLIST("A",3)=" 3 - % SERVICE CONNECTED"
- SET DATA(SUB,3,3)="% SERVICE CONNECTED"_U_2
- +9 SET ELIGLIST("A",4)=" 4 - VETERAN"
- SET DATA(SUB,4,4)="VETERAN"_U_1
- +10 SET ELIGLIST("A",5)=" 5 - TYPE"
- SET DATA(SUB,5,6)="TYPE"_U_2
- +11 SET ELIGLIST("A",6)=" 6 - ELIGIBILITY STATUS"
- SET DATA(SUB,6,8)="ELIGIBILITY STATUS"_U_2
- +12 SET ELIGLIST("A",7)=" 7 - CURRENT MEANS TEST"
- SET DATA(SUB,7,9)="CURRENT MEANS TEST"_U_2
- +13 SET ELIGLIST("A")="Enter your selection(s)"
- +14 SET ELIGLIST("?")="^D HELP^PXRMPDRS"
- +15 WRITE !!,"Select from the following eligibility items:"
- +16 SET LIST=$$SEL^PXRMPDRS(.ELIGLIST,7)
- +17 IF $DATA(DTOUT)!$DATA(DUOUT)
- QUIT
- +18 SET DATA(SUB)=LIST
- +19 SET DATA(SUB,"LEN")=$LENGTH(LIST,",")-1
- +20 QUIT
- +21 ;
- +22 ;==========================================================
- GCATYPE(DATA,SUB) ;Get the type of confidential addresses to use.
- +1 NEW CATLIST,IND,JND,LIST,MSG
- +2 DO HELP^DIE(2.141,"",.01,"S","MSG")
- +3 WRITE !!,"If the patient has an active confidential address, which of the following"
- +4 WRITE !,"confidential address categories are appropriate to use?",!
- +5 SET CATLIST("A")="If no selection is made the default is 2 and 4, enter your selection(s)"
- +6 SET JND=0
- +7 FOR IND=2:1:MSG("DIHELP")
- Begin DoDot:1
- +8 SET JND=JND+1
- +9 SET CATLIST("A",JND)=" "_MSG("DIHELP",IND)
- End DoDot:1
- +10 SET LIST=$$SEL^PXRMPDRS(.CATLIST,JND)
- +11 IF LIST=""
- SET LIST="2,4,"
- +12 SET DATA(SUB,22,"LEN")=$LENGTH(LIST,",")-1
- +13 SET DATA(SUB,22,"LIST")=LIST
- +14 QUIT
- +15 ;
- +16 ;==========================================================
- HELP ; -- help code.
- +1 WRITE !!,"You can choose any combination of numbers i.e., 1-4 or 1,3-5"
- +2 WRITE !!,"See the Clinical Reminders Managers manual for detailed explanations of each"
- +3 WRITE !,"of the selection items."
- +4 QUIT
- +5 ;
- +6 ;==========================================================
- INPSEL(DATA,SUB) ;Let the user select the inpatient information they want.
- +1 ;The first subscript of INPDATA is the selection number and the
- +2 ;the second subscript is the subscript where the data is returned
- +3 ;in VAIN. The first piece of INPDATA is the name of the data and the
- +4 ;second piece is the piece of VAIN this is displayed.
- +5 NEW INPLIST,ITEM,LIST
- +6 SET INPLIST("A",1)=" 1 - WARD LOCATION"
- SET DATA(SUB,1,4)="WARD"_U_2
- +7 SET INPLIST("A",2)=" 2 - ROOM-BED"
- SET DATA(SUB,2,5)="ROOM-BED"_U_1
- +8 SET INPLIST("A",3)=" 3 - ADMISSION DATE/TIME"
- SET DATA(SUB,3,7)="ADMISSION DATE/TIME"_U_2
- +9 SET INPLIST("A",4)=" 4 - ATTENDING PHYSICIAN"
- SET DATA(SUB,4,11)="ATTENDING"_U_2
- +10 SET INPLIST("A")="Enter your selection(s)"
- +11 SET INPLIST("?")="^D HELP^PXRMPDRS"
- +12 WRITE !!,"Select from the following inpatient items:"
- +13 SET LIST=$$SEL^PXRMPDRS(.INPLIST,4)
- +14 IF $DATA(DTOUT)!$DATA(DUOUT)
- QUIT
- +15 SET DATA(SUB)=LIST
- +16 SET DATA(SUB,"LEN")=$LENGTH(LIST,",")-1
- +17 QUIT
- +18 ;
- +19 ;==========================================================
- REMSEL(PLIEN,DATA,SUB) ;If the list was generated from a reminder report
- +1 ;let the user select the reminder data they want.
- +2 IF '$PIECE(^PXRMXP(810.5,PLIEN,0),U,9)
- SET DATA(SUB,"LEN")=0
- QUIT
- +3 NEW IEN,IND,REMLIST,RNAME
- +4 SET (IEN,IND)=0
- +5 FOR
- SET IEN=$ORDER(^PXRMXP(810.5,PLIEN,45,"B",IEN))
- if IEN=""
- QUIT
- Begin DoDot:1
- +6 SET RNAME=$PIECE(^PXD(811.9,IEN,0),U,3)
- +7 IF RNAME=""
- SET RNAME=$PIECE(^PXD(811.9,IEN,0),U,1)
- +8 SET IND=IND+1
- +9 SET DATA(SUB,"RNAME",IND)=RNAME
- +10 SET DATA(SUB,"IEN",IND)=IEN
- +11 SET REMLIST("A",IND)=" "_IND_" - "_RNAME
- End DoDot:1
- +12 SET REMLIST("A")="Enter your selection(s)"
- +13 SET REMLIST("?")="^D HELP^PXRMPDRS"
- +14 WRITE !!,"Include due status information for the following reminder(s):"
- +15 SET LIST=$$SEL^PXRMPDRS(.REMLIST,IND)
- +16 IF $DATA(DTOUT)!$DATA(DUOUT)
- QUIT
- +17 SET DATA(SUB)=LIST
- +18 SET DATA(SUB,"LEN")=$LENGTH(LIST,",")-1
- +19 QUIT
- +20 ;
- +21 ;==========================================================
- SEL(SELLIST,LEN) ;Select global list
- +1 NEW DIR,X,Y
- +2 MERGE DIR=SELLIST
- +3 SET DIR(0)="LO^1:"_LEN
- +4 DO ^DIR
- +5 QUIT Y
- +6 ;