[613] | 1 | PXRMPDR ;SLC/AGP,PKR - Patient List Demographic report main routine ;11/16/2007
|
---|
| 2 | ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
|
---|
| 3 | ;
|
---|
| 4 | EN(PLIEN) ; -- main entry point for PXRM PATIENT LIST DEMOGRAPHIC
|
---|
| 5 | N ARRAY,DC,DDATA,DELIM,DTOUT,DUOUT
|
---|
| 6 | W @IOF
|
---|
| 7 | K ^TMP("PXRMPLD",$J),^TMP("PXRMPLN",$J)
|
---|
| 8 | S DELIM=0
|
---|
| 9 | OPTION ;
|
---|
| 10 | W !,"Select the items to include on the report."
|
---|
| 11 | ADDSEL D ADDSEL^PXRMPDRS(.DDATA,"ADD")
|
---|
| 12 | I $D(DTOUT)!$D(DUOUT) Q
|
---|
| 13 | APPSEL D APPSEL^PXRMPDRS(.DDATA,"APP")
|
---|
| 14 | I $D(DTOUT)!$D(DUOUT) G ADDSEL
|
---|
| 15 | DEMSEL D DEMSEL^PXRMPDRS(.DDATA,"DEM")
|
---|
| 16 | I $D(DTOUT)!$D(DUOUT) G APPSEL
|
---|
| 17 | PFACSEL S DDATA("PFAC",0)=$$ASKYN^PXRMEUT("N","Include the patient's preferred facility")
|
---|
| 18 | I $D(DTOUT)!$D(DUOUT) G DEMSEL
|
---|
| 19 | S DDATA("PFAC","LEN")=$S(DDATA("PFAC",0)=1:1,1:0)
|
---|
| 20 | ELIGSEL D ELIGSEL^PXRMPDRS(.DDATA,"ELIG")
|
---|
| 21 | I $D(DTOUT)!$D(DUOUT) G PFACSEL
|
---|
| 22 | DATASEL D DATASEL^PXRMPDRS(PLIEN,.DDATA,"FIND")
|
---|
| 23 | I $D(DTOUT)!$D(DUOUT) G ELIGSEL
|
---|
| 24 | INPSEL D INPSEL^PXRMPDRS(.DDATA,"INP")
|
---|
| 25 | I $D(DTOUT)!$D(DUOUT) G DATASEL
|
---|
| 26 | REMDATA D REMSEL^PXRMPDRS(PLIEN,.DDATA,"REM")
|
---|
| 27 | I $D(DTOUT)!$D(DUOUT) G INPSEL
|
---|
| 28 | S DELIM=$$ASKYN^PXRMEUT("Y","Delimited Report:")
|
---|
| 29 | I $D(DTOUT)!$D(DUOUT) G REMDATA
|
---|
| 30 | S DC=$S(DELIM:$$DELIMSEL^PXRMXSD,1:U)
|
---|
| 31 | I $D(DTOUT)!$D(DUOUT) G OPTION
|
---|
| 32 | DEVICE ;
|
---|
| 33 | N DESC,DIR,PXRMQUE,RTN,SAVE,%ZIS
|
---|
| 34 | S %ZIS="M"
|
---|
| 35 | S DESC="Patient List Demographic Report"
|
---|
| 36 | S RTN="GETPDATA^PXRMPDR(DELIM,DC,PLIEN,.DDATA)"
|
---|
| 37 | S SAVE("DELIM")="",SAVE("DC")="",SAVE("PLIEN")=""
|
---|
| 38 | S SAVE("DDATA(")=""
|
---|
| 39 | S PXRMQUE=$$DEVICE^PXRMXQUE(RTN,DESC,.SAVE,.%ZIS,1)
|
---|
| 40 | I PXRMQUE'="" G EXIT
|
---|
| 41 | I $D(DTOUT)!$D(DUOUT) G EXIT
|
---|
| 42 | S DIR(0)="E" D ^DIR
|
---|
| 43 | EXIT D KVA^VADPT
|
---|
| 44 | K ^TMP("PXRMPLD",$J),^TMP("PXRMPLN",$J)
|
---|
| 45 | Q
|
---|
| 46 | ;
|
---|
| 47 | GETPDATA(DELIM,DC,PLIEN,DDATA) ;
|
---|
| 48 | N DATA,DATE,DCREAT,DFN,DTYPE,ERRMSG
|
---|
| 49 | N GETADD,GETAPP,GETDEM,GETELIG,GETFIND,GETINP,GETREM
|
---|
| 50 | N IEN,IND,JND,KND,LND
|
---|
| 51 | N LISTNAME,PIECE
|
---|
| 52 | N PDATA,PNAME,RIEN,TDATA
|
---|
| 53 | K ^TMP("PXRMPD",$J)
|
---|
| 54 | S LISTNAME=$P(^PXRMXP(810.5,PLIEN,0),U,1)
|
---|
| 55 | S DCREAT=$P(^PXRMXP(810.5,PLIEN,0),U,4)
|
---|
| 56 | S GETDEM=$S(DDATA("DEM","LEN")>0:1,1:0)
|
---|
| 57 | S GETADD=$S(DDATA("ADD","LEN")>0:1,1:0)
|
---|
| 58 | S GETINP=$S(DDATA("INP","LEN")>0:1,1:0)
|
---|
| 59 | S GETELIG=$S(DDATA("ELIG","LEN")>0:1,1:0)
|
---|
| 60 | S GETAPP=$S(DDATA("APP","LEN")>0:1,1:0)
|
---|
| 61 | S GETFIND=$S(DDATA("FIND","LEN")>0:1,1:0)
|
---|
| 62 | S GETREM=$S(DDATA("REM","LEN")>0:1,1:0)
|
---|
| 63 | S IEN=0
|
---|
| 64 | F S IEN=+$O(^PXRMXP(810.5,PLIEN,30,IEN)) Q:IEN=0 D
|
---|
| 65 | . S DFN=$P(^PXRMXP(810.5,PLIEN,30,IEN,0),U,1) I DFN="" Q
|
---|
| 66 | .;#DBIA 10035
|
---|
| 67 | . S PNAME=$P($G(^DPT(DFN,0)),U,1)
|
---|
| 68 | . I PNAME="" S PNAME="UNDEFINED"_DFN
|
---|
| 69 | . S ^TMP("PXRMPLN",$J,PNAME,DFN)=""
|
---|
| 70 | . S PDATA=""
|
---|
| 71 | . I GETDEM D
|
---|
| 72 | .. N VADM
|
---|
| 73 | .. D DEM^VADPT
|
---|
| 74 | .. F IND=1:1:DDATA("DEM","LEN") D
|
---|
| 75 | ... S JND=$P(DDATA("DEM"),",",IND)
|
---|
| 76 | ... S KND=0
|
---|
| 77 | ... F S KND=$O(DDATA("DEM",JND,KND)) Q:KND="" D
|
---|
| 78 | .... S PIECE=$P(DDATA("DEM",JND,KND),U,2)
|
---|
| 79 | .... S TDATA=$P(VADM(KND),U,PIECE)
|
---|
| 80 | .... S LND=""
|
---|
| 81 | .... F S LND=$O(VADM(KND,LND)) Q:LND="" D
|
---|
| 82 | ..... I TDATA'="" S TDATA=TDATA_"~"
|
---|
| 83 | ..... S TDATA=TDATA_$P(VADM(KND,LND),U,PIECE)
|
---|
| 84 | .... I KND=2,'DDATA("DEM","FULLSSN") S TDATA=$E(TDATA,8,11)
|
---|
| 85 | .... S $P(PDATA,U,KND)=TDATA
|
---|
| 86 | .. I PDATA'="" S ^TMP("PXRMPLD",$J,DFN,"DEM")=PDATA,PDATA=""
|
---|
| 87 | . I DDATA("PFAC",0)=1 D
|
---|
| 88 | ..;DBIA #1850
|
---|
| 89 | .. S TDATA=$$GET1^DIQ(2,DFN,27.02,"E","","ERRMSG")
|
---|
| 90 | .. I TDATA="" S TDATA="NONE"
|
---|
| 91 | .. S ^TMP("PXRMPLD",$J,DFN,"PFAC")=TDATA
|
---|
| 92 | . I GETADD D
|
---|
| 93 | .. N VAPA
|
---|
| 94 | .. D ADD^VADPT
|
---|
| 95 | .. F IND=1:1:DDATA("ADD","LEN") D
|
---|
| 96 | ... S JND=$P(DDATA("ADD"),",",IND)
|
---|
| 97 | ... S KND=0
|
---|
| 98 | ... F S KND=$O(DDATA("ADD",JND,KND)) Q:KND="" D
|
---|
| 99 | .... S PIECE=$P(DDATA("ADD",JND,KND),U,2)
|
---|
| 100 | .... S TDATA=$P(VAPA(KND),U,PIECE)
|
---|
| 101 | .... S $P(PDATA,U,KND)=TDATA
|
---|
| 102 | .. I PDATA'="" S ^TMP("PXRMPLD",$J,DFN,"ADD")=PDATA,PDATA=""
|
---|
| 103 | . I GETINP D
|
---|
| 104 | .. N VAIP
|
---|
| 105 | .. D INP^VADPT
|
---|
| 106 | .. F IND=1:1:DDATA("INP","LEN") D
|
---|
| 107 | ... S JND=$P(DDATA("INP"),",",IND)
|
---|
| 108 | ... S KND=0
|
---|
| 109 | ... F S KND=$O(DDATA("INP",JND,KND)) Q:KND="" D
|
---|
| 110 | .... S PIECE=$P(DDATA("INP",JND,KND),U,2)
|
---|
| 111 | .... S TDATA=$P(VAIN(KND),U,PIECE)
|
---|
| 112 | .... S $P(PDATA,U,KND)=TDATA
|
---|
| 113 | .. I PDATA'="" S ^TMP("PXRMPLD",$J,DFN,"INP")=PDATA,PDATA=""
|
---|
| 114 | . I GETELIG D
|
---|
| 115 | .. N VAEL
|
---|
| 116 | .. D ELIG^VADPT
|
---|
| 117 | .. F IND=1:1:DDATA("ELIG","LEN") D
|
---|
| 118 | ... S JND=$P(DDATA("ELIG"),",",IND)
|
---|
| 119 | ... S KND=0
|
---|
| 120 | ... F S KND=$O(DDATA("ELIG",JND,KND)) Q:KND="" D
|
---|
| 121 | .... S PIECE=$P(DDATA("ELIG",JND,KND),U,2)
|
---|
| 122 | .... S TDATA=$P(VAEL(KND),U,PIECE)
|
---|
| 123 | .... I KND=4 S TDATA=$S(TDATA=1:"YES",1:"NO")
|
---|
| 124 | .... S $P(PDATA,U,KND)=TDATA
|
---|
| 125 | .. I PDATA'="" S ^TMP("PXRMPLD",$J,DFN,"ELIG")=PDATA,PDATA=""
|
---|
| 126 | . D KVA^VADPT
|
---|
| 127 | . I GETREM D
|
---|
| 128 | .. S IND=0
|
---|
| 129 | .. F S IND=$O(DDATA("REM","IEN",IND)) Q:IND="" D
|
---|
| 130 | ... S PDATA=$G(^PXRMXP(810.5,PLIEN,30,IEN,"REM",IND,0))
|
---|
| 131 | ... I PDATA="" Q
|
---|
| 132 | ... S RIEN=$P(PDATA,U,1)
|
---|
| 133 | ... S ^TMP("PXRMPLD",$J,DFN,"REM",RIEN)=PDATA,PDATA=""
|
---|
| 134 | . I GETFIND D
|
---|
| 135 | .. N DL
|
---|
| 136 | .. F IND=1:1:DDATA("FIND","LEN") D
|
---|
| 137 | ... S JND=$P(DDATA("FIND"),",",IND)
|
---|
| 138 | ... S DTYPE=DDATA("FIND",JND,JND)
|
---|
| 139 | ... S KND=$O(^PXRMXP(810.5,PLIEN,30,IEN,"DATA","B",DTYPE,""))
|
---|
| 140 | ... S DL=$S(KND="":0,1:$L(^PXRMXP(810.5,PLIEN,30,IEN,"DATA",KND,0),U))
|
---|
| 141 | ... S DATA=$S(KND="":"",1:$P(^PXRMXP(810.5,PLIEN,30,IEN,"DATA",KND,0),U,2,DL))
|
---|
| 142 | ... S ^TMP("PXRMPLD",$J,DFN,"FIND",JND)=DATA
|
---|
| 143 | ;Get appointment data for all patients on the list.
|
---|
| 144 | I GETAPP D
|
---|
| 145 | . N ARRAY,COUNT
|
---|
| 146 | . S ARRAY(1)=DT,ARRAY(3)="I;R"
|
---|
| 147 | . S ARRAY(4)="^TMP($J,""PXRMPL""",ARRAY("FLDS")=""
|
---|
| 148 | . F IND=1:1:DDATA("APP","LEN") D
|
---|
| 149 | .. S JND=$P(DDATA("APP"),",",IND)
|
---|
| 150 | .. S KND=0
|
---|
| 151 | .. F S KND=$O(DDATA("APP",JND,KND)) Q:KND="" S ARRAY("FLDS")=ARRAY("FLDS")_KND_";"
|
---|
| 152 | . K ^TMP($J,"PXRMPL"),^TMP($J,"SDAMA301")
|
---|
| 153 | . S IND=0
|
---|
| 154 | . F S IND=+$O(^PXRMXP(810.5,PLIEN,30,IND)) Q:IND=0 D
|
---|
| 155 | .. S DFN=$P(^PXRMXP(810.5,PLIEN,30,IND,0),U,1)
|
---|
| 156 | .. I DFN'="" S ^TMP($J,"PXRMPL",DFN)=""
|
---|
| 157 | . S COUNT=$$SDAPI^SDAMA301(.ARRAY)
|
---|
| 158 | . I COUNT=-1 D Q
|
---|
| 159 | .. D APPERR^PXRMPDRS
|
---|
| 160 | .. S DDATA("APP","ERROR")=""
|
---|
| 161 | .. K ^TMP($J,"PXRMPL"),^TMP($J,"SDAMA301")
|
---|
| 162 | . F IND=1:1:COUNT D
|
---|
| 163 | .. S DFN=""
|
---|
| 164 | .. F S DFN=$O(^TMP($J,"SDAMA301",DFN)) Q:DFN="" D
|
---|
| 165 | ... S (JND,KND)=0
|
---|
| 166 | ... F S JND=$O(^TMP($J,"SDAMA301",DFN,JND)) Q:JND="" D
|
---|
| 167 | .... S DATE=0
|
---|
| 168 | .... F S DATE=$O(^TMP($J,"SDAMA301",DFN,JND,DATE)) Q:DATE="" D
|
---|
| 169 | ..... S KND=KND+1
|
---|
| 170 | ..... S TDATA=^TMP($J,"SDAMA301",DFN,JND,DATE)
|
---|
| 171 | ..... S PDATA=$$FMTE^XLFDT($P(TDATA,U,1))
|
---|
| 172 | ..... S TDATA=$P(TDATA,U,2),TDATA=$P(TDATA,";",2)
|
---|
| 173 | ..... S PDATA=PDATA_U_TDATA
|
---|
| 174 | ..... S ^TMP("PXRMPLD",$J,DFN,"APP",KND)=PDATA
|
---|
| 175 | . K ^TMP($J,"PXRMPL"),^TMP($J,"SDAMA301")
|
---|
| 176 | I DELIM=1 D DELIMPR^PXRMPDRP(DC,PLIEN,.DDATA)
|
---|
| 177 | I DELIM=0 D REGPR^PXRMPDRP(PLIEN,.DDATA)
|
---|
| 178 | Q
|
---|
| 179 | ;
|
---|
| 180 | LENGTH(STR,STR1) ;
|
---|
| 181 | I ($L(STR)+$L(STR1))>245 W !,STR S STR=STR1
|
---|
| 182 | E S STR=STR_U_STR1,STR1=""
|
---|
| 183 | Q
|
---|
| 184 | ;
|
---|
| 185 | PAGE ;
|
---|
| 186 | I ($E(IOST,1,2)="C-")&(IO=IO(0)) D
|
---|
| 187 | .S DIR(0)="E"
|
---|
| 188 | .W !
|
---|
| 189 | .D ^DIR K DIR
|
---|
| 190 | I $D(DUOUT)!($D(DTOUT))!($D(DIROUT)) S DONE=1 Q
|
---|
| 191 | W:$D(IOF) @IOF
|
---|
| 192 | S PAGE=PAGE+1
|
---|
| 193 | I ($E(IOST,1,2)="C-")&(IO=IO(0)) W @IOF
|
---|
| 194 | Q
|
---|
| 195 | ;
|
---|