Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMPDRS

PXRMPDRS.m

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