Changeset 636 for FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMPDR.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• CLINICAL_REMINDERS-PXRM/PXRMPDR.m (modified) (10 diffs)

FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMPDR.m

@@ -1 @@
-PXRMPDR ;SLC/AGP,PKR - Patient List Demographic report main routine ;11/16/2007
- ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
+PXRMPDR ;SLC/AGP,PKR - Patient List Demographic report main routine ;07/17/2006
+ ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
  ;
 EN(PLIEN) ; -- main entry point for PXRM PATIENT LIST DEMOGRAPHIC
- N ARRAY,DC,DDATA,DELIM,DTOUT,DUOUT
+ N ADDDATA,APPDATA,ARRAY,BACK,CNT,DC,DEMDATA,DELIM,DIC,DIR,DTOUT,DUOUT
+ N ELIGDATA,IEN,INPDATA
+ N FINDDATA,NAME,NODE,PFACDATA,PTIEN
+ N QUIT,REMDATA
+ N X,Y,YESNO
  W @IOF
  K ^TMP("PXRMPLD",$J),^TMP("PXRMPLN",$J)
- S DELIM=0
+ S BACK=0,DELIM=0,QUIT=0
 OPTION ;
  W !,"Select the items to include on the report."
-ADDSEL D ADDSEL^PXRMPDRS(.DDATA,"ADD")
+ADDSEL D ADDSEL^PXRMPDRS(.ADDDATA)
  I $D(DTOUT)!$D(DUOUT) Q
-APPSEL D APPSEL^PXRMPDRS(.DDATA,"APP")
+APPSEL D APPSEL^PXRMPDRS(.APPDATA)
  I $D(DTOUT)!$D(DUOUT) G ADDSEL
-DEMSEL D DEMSEL^PXRMPDRS(.DDATA,"DEM")
+DEMSEL D DEMSEL^PXRMPDRS(.DEMDATA)
  I $D(DTOUT)!$D(DUOUT) G APPSEL
-PFACSEL S DDATA("PFAC",0)=$$ASKYN^PXRMEUT("N","Include the patient's preferred facility")
+PFACSEL S PFACDATA(0)=$$ASKYN^PXRMEUT("N","Include the patient's preferred facility")
  I $D(DTOUT)!$D(DUOUT) G DEMSEL
- S DDATA("PFAC","LEN")=$S(DDATA("PFAC",0)=1:1,1:0)
-ELIGSEL D ELIGSEL^PXRMPDRS(.DDATA,"ELIG")
+ S PFACDATA("LEN")=$S(PFACDATA(0)=1:1,1:0)
+ELIGSEL D ELIGSEL^PXRMPDRS(.ELIGDATA)
  I $D(DTOUT)!$D(DUOUT) G PFACSEL
-DATASEL D DATASEL^PXRMPDRS(PLIEN,.DDATA,"FIND")
+DATASEL D DATASEL^PXRMPDRS(PLIEN,.FINDDATA)
  I $D(DTOUT)!$D(DUOUT) G ELIGSEL
-INPSEL D INPSEL^PXRMPDRS(.DDATA,"INP")
+INPSEL D INPSEL^PXRMPDRS(.INPDATA)
  I $D(DTOUT)!$D(DUOUT) G DATASEL
-REMDATA D REMSEL^PXRMPDRS(PLIEN,.DDATA,"REM")
+REMDATA D REMSEL^PXRMPDRS(PLIEN,.REMDATA)
  I $D(DTOUT)!$D(DUOUT) G INPSEL
  S DELIM=$$ASKYN^PXRMEUT("Y","Delimited Report:")
  I $D(DTOUT)!$D(DUOUT) G REMDATA
- S DC=$S(DELIM:$$DELIMSEL^PXRMXSD,1:U)
+ I DELIM S DC=$$DELIMSEL^PXRMXSD
  I $D(DTOUT)!$D(DUOUT) G OPTION
 DEVICE ;
- N DESC,DIR,PXRMQUE,RTN,SAVE,%ZIS
+ N DIR,PXRMQUE,%ZIS,ZTDESC,ZTRTN,ZTSAVE
  S %ZIS="M"
- S DESC="Patient List Demographic Report"
- S RTN="GETPDATA^PXRMPDR(DELIM,DC,PLIEN,.DDATA)"
- S SAVE("DELIM")="",SAVE("DC")="",SAVE("PLIEN")=""
- S SAVE("DDATA(")=""
- S PXRMQUE=$$DEVICE^PXRMXQUE(RTN,DESC,.SAVE,.%ZIS,1)
- I PXRMQUE'="" G EXIT
+ S ZTDESC="Patient List Demographic"
+ S ZTRTN="GETDATA^PXRMPDR(DELIM,PLIEN,.DEMDATA,.PFACDATA,.ADDDATA,.INPDATA,.APPDATA,.FINDDATA,.REMDATA)"
+ S ZTSAVE("*")=""
+ S PXRMQUE=0
+ S PXRMQUE=$$DEVICE^PXRMXQUE(ZTRTN,ZTDESC,.ZTSAVE,.%ZIS,.ZTSK)
+ I PXRMQUE=1 G EXIT
  I $D(DTOUT)!$D(DUOUT) G EXIT
+ ;
  S DIR(0)="E" D ^DIR
 EXIT D KVA^VADPT
@@ -45 +50 @@
  Q
  ;
-GETPDATA(DELIM,DC,PLIEN,DDATA) ;
+GETDATA(DELIM,PLIEN,DEMDATA,PFACDATA,ADDDATA,INPDATA,APPDATA,FINDDATA,REMDATA) ;
  N DATA,DATE,DCREAT,DFN,DTYPE,ERRMSG
  N GETADD,GETAPP,GETDEM,GETELIG,GETFIND,GETINP,GETREM
@@ -54 +59 @@
  S LISTNAME=$P(^PXRMXP(810.5,PLIEN,0),U,1)
  S DCREAT=$P(^PXRMXP(810.5,PLIEN,0),U,4)
- S GETDEM=$S(DDATA("DEM","LEN")>0:1,1:0)
- S GETADD=$S(DDATA("ADD","LEN")>0:1,1:0)
- S GETINP=$S(DDATA("INP","LEN")>0:1,1:0)
- S GETELIG=$S(DDATA("ELIG","LEN")>0:1,1:0)
- S GETAPP=$S(DDATA("APP","LEN")>0:1,1:0)
- S GETFIND=$S(DDATA("FIND","LEN")>0:1,1:0)
- S GETREM=$S(DDATA("REM","LEN")>0:1,1:0)
+ S GETDEM=$S(DEMDATA("LEN")>0:1,1:0)
+ S GETADD=$S(ADDDATA("LEN")>0:1,1:0)
+ S GETINP=$S(INPDATA("LEN")>0:1,1:0)
+ S GETELIG=$S(ELIGDATA("LEN")>0:1,1:0)
+ S GETAPP=$S(APPDATA("LEN")>0:1,1:0)
+ S GETFIND=$S(FINDDATA("LEN")>0:1,1:0)
+ S GETREM=$S(REMDATA("LEN")>0:1,1:0)
  S IEN=0
  F  S IEN=+$O(^PXRMXP(810.5,PLIEN,30,IEN)) Q:IEN=0  D
@@ -72 +77 @@
  .. N VADM
  .. D DEM^VADPT
- .. F IND=1:1:DDATA("DEM","LEN") D
- ... S JND=$P(DDATA("DEM"),",",IND)
- ... S KND=0
- ... F  S KND=$O(DDATA("DEM",JND,KND)) Q:KND=""  D
- .... S PIECE=$P(DDATA("DEM",JND,KND),U,2)
+ .. F IND=1:1:DEMDATA("LEN") D
+ ... S JND=$P(DEMDATA,",",IND)
+ ... S KND=0
+ ... F  S KND=$O(DEMDATA(JND,KND)) Q:KND=""  D
+ .... S PIECE=$P(DEMDATA(JND,KND),U,2)
  .... S TDATA=$P(VADM(KND),U,PIECE)
  .... S LND=""
@@ -82 +87 @@
  ..... I TDATA'="" S TDATA=TDATA_"~"
  ..... S TDATA=TDATA_$P(VADM(KND,LND),U,PIECE)
- .... I KND=2,'DDATA("DEM","FULLSSN") S TDATA=$E(TDATA,8,11)
- .... S $P(PDATA,U,KND)=TDATA
- .. I PDATA'="" S ^TMP("PXRMPLD",$J,DFN,"DEM")=PDATA,PDATA=""
- . I DDATA("PFAC",0)=1 D
+ .... I KND=2,'DEMDATA("FULLSSN") S TDATA=$E(TDATA,8,11)
+ .... S $P(PDATA,U,KND)=TDATA
+ .. I PDATA'="" S ^TMP("PXRMPLD",$J,DFN,"DEMDATA")=PDATA,PDATA=""
+ . I PFACDATA(0)=1 D
  ..;DBIA #1850
  .. S TDATA=$$GET1^DIQ(2,DFN,27.02,"E","","ERRMSG")
  .. I TDATA="" S TDATA="NONE"
- .. S ^TMP("PXRMPLD",$J,DFN,"PFAC")=TDATA
+ .. S ^TMP("PXRMPLD",$J,DFN,"PFACDATA")=TDATA
  . I GETADD D
  .. N VAPA
  .. D ADD^VADPT
- .. F IND=1:1:DDATA("ADD","LEN") D
- ... S JND=$P(DDATA("ADD"),",",IND)
- ... S KND=0
- ... F  S KND=$O(DDATA("ADD",JND,KND)) Q:KND=""  D
- .... S PIECE=$P(DDATA("ADD",JND,KND),U,2)
+ .. F IND=1:1:ADDDATA("LEN") D
+ ... S JND=$P(ADDDATA,",",IND)
+ ... S KND=0
+ ... F  S KND=$O(ADDDATA(JND,KND)) Q:KND=""  D
+ .... S PIECE=$P(ADDDATA(JND,KND),U,2)
  .... S TDATA=$P(VAPA(KND),U,PIECE)
  .... S $P(PDATA,U,KND)=TDATA
- .. I PDATA'="" S ^TMP("PXRMPLD",$J,DFN,"ADD")=PDATA,PDATA=""
+ .. I PDATA'="" S ^TMP("PXRMPLD",$J,DFN,"ADDDATA")=PDATA,PDATA=""
  . I GETINP D
  .. N VAIP
  .. D INP^VADPT
- .. F IND=1:1:DDATA("INP","LEN") D
- ... S JND=$P(DDATA("INP"),",",IND)
- ... S KND=0
- ... F  S KND=$O(DDATA("INP",JND,KND)) Q:KND=""  D
- .... S PIECE=$P(DDATA("INP",JND,KND),U,2)
+ .. F IND=1:1:INPDATA("LEN") D
+ ... S JND=$P(INPDATA,",",IND)
+ ... S KND=0
+ ... F  S KND=$O(INPDATA(JND,KND)) Q:KND=""  D
+ .... S PIECE=$P(INPDATA(JND,KND),U,2)
  .... S TDATA=$P(VAIN(KND),U,PIECE)
  .... S $P(PDATA,U,KND)=TDATA
- .. I PDATA'="" S ^TMP("PXRMPLD",$J,DFN,"INP")=PDATA,PDATA=""
+ .. I PDATA'="" S ^TMP("PXRMPLD",$J,DFN,"INPDATA")=PDATA,PDATA=""
  . I GETELIG D
  .. N VAEL
  .. D ELIG^VADPT
- .. F IND=1:1:DDATA("ELIG","LEN") D
- ... S JND=$P(DDATA("ELIG"),",",IND)
- ... S KND=0
- ... F  S KND=$O(DDATA("ELIG",JND,KND)) Q:KND=""  D
- .... S PIECE=$P(DDATA("ELIG",JND,KND),U,2)
+ .. F IND=1:1:ELIGDATA("LEN") D
+ ... S JND=$P(ELIGDATA,",",IND)
+ ... S KND=0
+ ... F  S KND=$O(ELIGDATA(JND,KND)) Q:KND=""  D
+ .... S PIECE=$P(ELIGDATA(JND,KND),U,2)
  .... S TDATA=$P(VAEL(KND),U,PIECE)
  .... I KND=4 S TDATA=$S(TDATA=1:"YES",1:"NO")
  .... S $P(PDATA,U,KND)=TDATA
- .. I PDATA'="" S ^TMP("PXRMPLD",$J,DFN,"ELIG")=PDATA,PDATA=""
+ .. I PDATA'="" S ^TMP("PXRMPLD",$J,DFN,"ELIGDATA")=PDATA,PDATA=""
  . D KVA^VADPT
  . I GETREM D
  .. S IND=0
- .. F  S IND=$O(DDATA("REM","IEN",IND)) Q:IND=""  D
+ .. F  S IND=$O(REMDATA("IEN",IND)) Q:IND=""  D
  ... S PDATA=$G(^PXRMXP(810.5,PLIEN,30,IEN,"REM",IND,0))
  ... I PDATA="" Q
  ... S RIEN=$P(PDATA,U,1)
- ... S ^TMP("PXRMPLD",$J,DFN,"REM",RIEN)=PDATA,PDATA=""
+ ... S ^TMP("PXRMPLD",$J,DFN,"REMDATA",RIEN)=PDATA,PDATA=""
  . I GETFIND D
  .. N DL
- .. F IND=1:1:DDATA("FIND","LEN") D
- ... S JND=$P(DDATA("FIND"),",",IND)
- ... S DTYPE=DDATA("FIND",JND,JND)
+ .. F IND=1:1:FINDDATA("LEN") D
+ ... S JND=$P(FINDDATA,",",IND)
+ ... S DTYPE=FINDDATA(JND,JND)
  ... S KND=$O(^PXRMXP(810.5,PLIEN,30,IEN,"DATA","B",DTYPE,""))
  ... S DL=$S(KND="":0,1:$L(^PXRMXP(810.5,PLIEN,30,IEN,"DATA",KND,0),U))
  ... S DATA=$S(KND="":"",1:$P(^PXRMXP(810.5,PLIEN,30,IEN,"DATA",KND,0),U,2,DL))
- ... S ^TMP("PXRMPLD",$J,DFN,"FIND",JND)=DATA
+ ... S ^TMP("PXRMPLD",$J,DFN,"FINDDATA",JND)=DATA
  ;Get appointment data for all patients on the list.
  I GETAPP D
@@ -146 +151 @@
  . S ARRAY(1)=DT,ARRAY(3)="I;R"
  . S ARRAY(4)="^TMP($J,""PXRMPL""",ARRAY("FLDS")=""
- . F IND=1:1:DDATA("APP","LEN") D
- .. S JND=$P(DDATA("APP"),",",IND)
+ . F IND=1:1:APPDATA("LEN") D
+ .. S JND=$P(APPDATA,",",IND)
  .. S KND=0
- .. F  S KND=$O(DDATA("APP",JND,KND)) Q:KND=""  S ARRAY("FLDS")=ARRAY("FLDS")_KND_";"
+ .. F  S KND=$O(APPDATA(JND,KND)) Q:KND=""  S ARRAY("FLDS")=ARRAY("FLDS")_KND_";"
  . K ^TMP($J,"PXRMPL"),^TMP($J,"SDAMA301")
  . S IND=0
@@ -158 +163 @@
  . I COUNT=-1 D  Q
  .. D APPERR^PXRMPDRS
- .. S DDATA("APP","ERROR")=""
+ .. S APPDATA("ERROR")=""
  .. K ^TMP($J,"PXRMPL"),^TMP($J,"SDAMA301")
  . F IND=1:1:COUNT D
@@ -172 +177 @@
  ..... S TDATA=$P(TDATA,U,2),TDATA=$P(TDATA,";",2)
  ..... S PDATA=PDATA_U_TDATA
- ..... S ^TMP("PXRMPLD",$J,DFN,"APP",KND)=PDATA
+ ..... S ^TMP("PXRMPLD",$J,DFN,"APPDATA",KND)=PDATA
  . K ^TMP($J,"PXRMPL"),^TMP($J,"SDAMA301")
- I DELIM=1 D DELIMPR^PXRMPDRP(DC,PLIEN,.DDATA)
- I DELIM=0 D REGPR^PXRMPDRP(PLIEN,.DDATA)
+ I DELIM=1 D DELIMPR^PXRMPDRP(DC,PLIEN,.ADDDATA,.APPDATA,.DEMDATA,.FINDDATA,.INPDATA,.PFACDATA,.REMDATA)
+ I DELIM=0 D REGPR^PXRMPDRP(PLIEN,.ADDDATA,.APPDATA,.DEMDATA,.FINDDATA,.INPDATA,.PFACDATA,.REMDATA)
  Q
  ;
@@ -184 +189 @@
  ;
 PAGE ;
- I ($E(IOST,1,2)="C-")&(IO=IO(0)) D
+ I ($E(IOST)="C")&(IO=IO(0)) D
  .S DIR(0)="E"
  .W !
@@ -191 +196 @@
  W:$D(IOF) @IOF
  S PAGE=PAGE+1
- I ($E(IOST,1,2)="C-")&(IO=IO(0)) W @IOF
- Q
- ;
+ I $E(IOST)="C",IO=IO(0) W @IOF
+ Q
+ ;