Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMPDRP.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMPDRP.m
r613 r623 1 PXRMPDRP ;SLC/AGP,PKR - Patient List Demographic report print routine ;11/16/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 ; 4 ADDTXT(TEXT) ;Accumulate text in ^TMP. 5 S LINCNT=LINCNT+1 6 S ^TMP("PXRMPDEM",$J,LINCNT)=TEXT 7 Q 8 ; 9 APPHDR(DC,DDATA,SUB) ;Build the appointment header. 10 I DDATA(SUB,"LEN")'>0 Q 11 N HDR,IND,JND,KND,LND,TEMP 12 S IND=0,HDR="" 13 F IND=1:1:DDATA(SUB,"MAX") D 14 . F JND=1:1:DDATA(SUB,"LEN") D 15 .. S KND=$P(DDATA(SUB),",",JND) 16 .. S LND="" 17 .. F S LND=$O(DDATA(SUB,KND,LND)) Q:LND="" D 18 ... S TEMP=$P(DDATA(SUB,KND,LND),U,1) 19 ... S HDR=HDR_TEMP_IND_DC 20 S DDATA(SUB,"HDR")=HDR 21 Q 22 ; 23 APPPRINT(DFN,DDATA,SUB) ;Print appointment data. 24 N CLINIC,COUNT,DATE,HDR,IND,JND,KND,LINE,PCLINIC,PDATE,TEMP 25 S (PCLINIC,PDATE)=0 26 F IND=1:1:DDATA(SUB,"LEN") D 27 . S JND=$P(DDATA(SUB),",",IND) 28 . I JND=1 S PDATE=1 29 . I JND=2 S PCLINIC=1 30 S HDR="" 31 I PDATE S HDR=" "_$P(DDATA(SUB,1,1),U,1) 32 I PCLINIC S HDR=HDR_" "_$P(DDATA(SUB,2,2),U,1) 33 D ADDTXT(" ") 34 D ADDTXT("Appointment Data") 35 D ADDTXT(HDR) 36 S COUNT=0 37 F S COUNT=$O(^TMP("PXRMPLD",$J,DFN,"APP",COUNT)) Q:COUNT="" D 38 . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"APP",COUNT)) 39 . S LINE="" 40 . I PDATE S LINE=LINE_$P(TEMP,U,1) 41 . I PCLINIC S LINE=LINE_" "_$P(TEMP,U,2) 42 . D ADDTXT(LINE) 43 Q 44 ; 45 DELIMHDR(DC,DDATA,SUB) ;Build the delimited header for a data type. 46 I DDATA(SUB,"LEN")'>0 Q 47 N HDR,IND,JND,KND,LND,MAX,TEMP 48 S IND=0,HDR="" 49 F IND=1:1:DDATA(SUB,"LEN") D 50 . S JND=$P(DDATA(SUB),",",IND) 51 . S KND="" 52 . F S KND=$O(DDATA(SUB,JND,KND)) Q:KND="" D 53 .. S TEMP=$P(DDATA(SUB,JND,KND),U,1) 54 .. S MAX=$P(DDATA(SUB,JND,KND),U,3) 55 .. I MAX="" S HDR=HDR_TEMP_DC 56 .. I +MAX>0 F LND=1:1:MAX S HDR=HDR_TEMP_LND_DC 57 S DDATA(SUB,"HDR")=HDR 58 Q 59 ; 60 DELIMPR(DC,PLIEN,DDATA) ; 61 ;Print the delimited report. 62 N DATALIST,DFN,IND,NDT,PNAME 63 S NDT=0 64 I DDATA("ADD","LEN")>0 S NDT=NDT+1,DATALIST(NDT)="ADD" 65 I DDATA("APP","LEN")>0 S NDT=NDT+1,DATALIST(NDT)="APP" 66 I DDATA("DEM","LEN")>0 S NDT=NDT+1,DATALIST(NDT)="DEM" 67 I DDATA("ELIG","LEN")>0 S NDT=NDT+1,DATALIST(NDT)="ELIG" 68 I DDATA("FIND","LEN")>0 S NDT=NDT+1,DATALIST(NDT)="FIND" 69 I DDATA("INP","LEN")>0 S NDT=NDT+1,DATALIST(NDT)="INP" 70 I DDATA("PFAC","LEN")>0 S NDT=NDT+1,DATALIST(NDT)="PFAC" 71 I DDATA("REM","LEN")>0 S NDT=NDT+1,DATALIST(NDT)="REM" 72 S DATALIST(0)=NDT 73 D TITLE(PLIEN,1) 74 ;Create the delimited header. 75 F IND=1:1:NDT D 76 . I DATALIST(IND)="ADD" D DELIMHDR(DC,.DDATA,"ADD") Q 77 . I DATALIST(IND)="APP" D APPHDR(DC,.DDATA,"APP") Q 78 . I DATALIST(IND)="DEM" D DELIMHDR(DC,.DDATA,"DEM") Q 79 . I DATALIST(IND)="ELIG" D DELIMHDR(DC,.DDATA,"ELIG") Q 80 . I DATALIST(IND)="FIND" D DELIMHDR(DC,.DDATA,"FIND") Q 81 . I DATALIST(IND)="INP" D DELIMHDR(DC,.DDATA,"INP") Q 82 . I DATALIST(IND)="PFAC" D PFACHDR(.DDATA,"PFAC") 83 . I DATALIST(IND)="REM" D REMHDR(DC,.DDATA,"REM") Q 84 D DELTITLE(DC,.DATALIST,.DDATA) 85 S PNAME=":" 86 F S PNAME=$O(^TMP("PXRMPLN",$J,PNAME)) Q:PNAME="" D 87 . S DFN="" 88 . F S DFN=$O(^TMP("PXRMPLN",$J,PNAME,DFN)) Q:DFN="" D 89 .. W !,PNAME_DC 90 .. F IND=1:1:NDT D 91 ... I DATALIST(IND)="ADD" D PDELDATA(DFN,DC,DATALIST(IND),.DDATA,"ADD") Q 92 ... I DATALIST(IND)="APP" D PAPPDATA(DFN,DC,.DDATA,"APP") Q 93 ... I DATALIST(IND)="DEM" D PDELDATA(DFN,DC,DATALIST(IND),.DDATA,"DEM") Q 94 ... I DATALIST(IND)="ELIG" D PDELDATA(DFN,DC,DATALIST(IND),.DDATA,"ELIG") Q 95 ... I DATALIST(IND)="FIND" D PFINDATA(DFN,DC,.DDATA,"FIND") Q 96 ... I DATALIST(IND)="INP" D PDELDATA(DFN,DC,DATALIST(IND),.DDATA,"INP") Q 97 ... I DATALIST(IND)="PFAC" D PFACDATA(DFN,.DDATA,"PFAC") Q 98 ... I DATALIST(IND)="REM" D PREMDATA(DFN,DC,.DDATA,"REM") Q 99 .. W "\\" 100 Q 101 ; 102 DELTITLE(DC,DATALIST,DDATA) ;Combine all the headers to create the delimited title. 103 W !,"PATIENT"_DC 104 N IND 105 F IND=1:1:DATALIST(0) W DDATA(DATALIST(IND),"HDR") 106 W "\\" 107 Q 108 ; 109 FINDPR(DFN,DDATA,SUB) ;Print finding information. 110 N IND,JND,LINE,TEMP 111 D ADDTXT(" ") 112 S LINE="Finding Data" 113 D ADDTXT(LINE) 114 F IND=1:1:DDATA(SUB,"LEN") D 115 . S JND=$P(DDATA(SUB),",",IND) 116 . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"FIND",JND)) 117 . I TEMP="" Q 118 . S LINE=" "_$P(DDATA(SUB,JND,JND),U,1)_": "_TEMP 119 . D ADDTXT(LINE) 120 Q 121 ; 122 OUTPUT ;Output the text. 123 N IND,LC,LO,VSIZE 124 S VSIZE=IOSL-2 125 S (LC,LO)=0 126 F IND=1:1:LINCNT D 127 . S LC=LC+1,LO=LO+1 128 . W !,^TMP("PXRMPDEM",$J,LC) 129 . I LO=VSIZE D 130 .. D PAGE 131 .. I $D(DTOUT)!$D(DUOUT) S IND=LINCNT Q 132 .. S LO=0 133 Q 134 ; 135 PAGE ; 136 I ($E(IOST,1,2)="C-")&(IO=IO(0)) D 137 . N DIR 138 . S DIR(0)="E" 139 . W ! 140 . D ^DIR K DIR 141 I $D(DUOUT)!$D(DTOUT) Q 142 W:$D(IOF) @IOF 143 I ($E(IOST,1,2)="C-")&(IO=IO(0)) W @IOF 144 Q 145 ; 146 PAPPDATA(DFN,DC,DDATA,SUB) ;Print the delimited appointment data. 147 N IND,JND,KND,LINE,LND,PIECE,TEMP 148 I DDATA(SUB,"LEN")'>0 Q 149 S LINE="" 150 F IND=1:1:DDATA(SUB,"MAX") D 151 . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"APP",IND)) 152 . F JND=1:1:DDATA(SUB,"LEN") D 153 .. S KND=$P(DDATA(SUB),",",JND) 154 .. S LND="" 155 .. F S LND=$O(DDATA(SUB,KND,LND)) Q:LND="" D 156 ... S PIECE=$P(DDATA(SUB,KND,KND),U,2) 157 ... S LINE=LINE_$P(TEMP,U,PIECE)_DC 158 W LINE 159 Q 160 ; 161 PDELDATA(DFN,DC,DTYPE,DDATA,SUB) ;Print the delimited data. 162 N IND,JND,KND,LINE,LND,TEMP,TTEMP 163 S TEMP=$G(^TMP("PXRMPLD",$J,DFN,DTYPE)) 164 S LINE="" 165 F IND=1:1:DDATA(DTYPE,"LEN") D 166 . S JND=$P(DDATA(DTYPE),",",IND) 167 . S KND="" 168 . F S KND=$O(DDATA(DTYPE,JND,KND)) Q:KND="" D 169 .. S MAX=$P(DDATA(DTYPE,JND,KND),U,3) 170 .. I MAX="" S LINE=LINE_$P(TEMP,U,KND)_DC Q 171 .. I +MAX>1 S TTEMP=$P(TEMP,U,KND) F LND=1:1:MAX S LINE=LINE_$P(TTEMP,"~",LND)_DC 172 W LINE 173 Q 174 ; 175 PFACHDR(DDATA,SUB) ;Build the preferred facility header. 176 I DDATA(SUB,0)=1 S DDATA(SUB,"HDR")="PATIENT'S PREFERRED FACILITY" 177 Q 178 ; 179 PFACDATA(DFN,DDATA,SUB) ;Print the patient's preferred facility data, delimited. 180 I DDATA(SUB,0)=0 Q 181 W ^TMP("PXRMPLD",$J,DFN,"PFAC") 182 Q 183 ; 184 PFACPR(DFN,DDATA,SUB) ;Print the patient's preferred facility. 185 I DDATA(SUB,0)=0 Q 186 D ADDTXT("Patient's Preferred Facility") 187 D ADDTXT(" "_$G(^TMP("PXRMPLD",$J,DFN,"PFAC"))) 188 Q 189 ; 190 PFINDATA(DFN,DC,DDATA,SUB) ;Print the finding data. 191 N IND,JND,LINE,TEMP 192 I DDATA(SUB,"LEN")'>0 Q 193 S LINE="" 194 F IND=1:1:DDATA(SUB,"LEN") D 195 . S JND=$P(DDATA(SUB),",",IND) 196 . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"FIND",JND)) 197 . S LINE=LINE_TEMP_DC 198 W LINE 199 Q 200 ; 201 PREMDATA(DFN,DC,DDATA,SUB) ;Print the reminder data. 202 N IND,JND,LINE,TEMP 203 I DDATA(SUB,"LEN")'>0 Q 204 S LINE="" 205 F IND=1:1:DDATA(SUB,"LEN") D 206 . S JND=$P(DDATA(SUB),",",IND) 207 . S LINE=LINE_DDATA(SUB,"RNAME",JND)_DC 208 . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"REM",DDATA(SUB,"IEN",JND))) 209 . S LINE=LINE_$P(TEMP,U,2)_DC_$P(TEMP,U,3)_"^"_$P(TEMP,U,4)_DC 210 W LINE 211 Q 212 ; 213 REGPR(PLIEN,DDATA,SUB) ; 214 ;Print the regular report.. 215 N DATATYPE,DFN,PNAME,LINCNT 216 K ^TMP("PXRMPDEM",$J) 217 S LINCNT=0 218 D TITLE(PLIEN,0) 219 S PNAME=":" 220 F S PNAME=$O(^TMP("PXRMPLN",$J,PNAME)) Q:PNAME="" D 221 . S DFN=0 222 . F S DFN=$O(^TMP("PXRMPLN",$J,PNAME,DFN)) Q:DFN="" D 223 .. D ADDTXT(" ") 224 .. D ADDTXT("---------- "_PNAME_" DFN="_DFN_" ----------") 225 .. S DATATYPE="" 226 .. F S DATATYPE=$O(^TMP("PXRMPLD",$J,DFN,DATATYPE)) Q:DATATYPE="" D 227 ... I DATATYPE="ADD" D VADPTPR(DFN,"Address Data",DATATYPE,.DDATA,"ADD") Q 228 ... I DATATYPE="APP" D APPPRINT(DFN,.DDATA,"APP") Q 229 ... I DATATYPE="DEM" D VADPTPR(DFN,"Demographic Data",DATATYPE,.DDATA,"DEM") Q 230 ... I DATATYPE="ELIG" D VADPTPR(DFN,"Eligibility Data",DATATYPE,.DDATA,"ELIG") Q 231 ... I DATATYPE="FIND" D FINDPR(DFN,.DDATA,"FIND") Q 232 ... I DATATYPE="INP" D VADPTPR(DFN,"Inpatient Data",DATATYPE,.DDATA,"INP") Q 233 ... I DATATYPE="PFAC" D PFACPR(DFN,.DDATA,"PFAC") Q 234 ... I DATATYPE="REM" D REMPR(DFN,.DDATA,"REM") Q 235 D OUTPUT 236 K ^TMP("PXRMPDEM",$J) 237 Q 238 ; 239 REMHDR(DC,DDATA,SUB) ;Build the reminder data delimited header. 240 N HDR,IND,JND 241 S HDR="" 242 F IND=1:1:DDATA(SUB,"LEN") D 243 . S JND=$P(DDATA(SUB),",",IND) 244 . S HDR=HDR_"REMINDER"_JND_DC_"STATUS"_JND_DC_"DUE DATE"_JND_DC_"LAST DONE"_JND_DC 245 S DDATA(SUB,"HDR")=HDR 246 Q 247 ; 248 REMPR(DFN,DDATA,SUB) ;Print reminder status information. 249 N DUE,IND,JND,LAST,LINE,NSP,STATUS,TEMP 250 D ADDTXT(" ") 251 S LINE="Reminder:"_$$INSCHR^PXRMEXLC(27," ")_"--STATUS-- --DUE DATE-- --LAST DONE--" 252 D ADDTXT(LINE) 253 F IND=1:1:DDATA(SUB,"LEN") D 254 . S JND=$P(DDATA(SUB),",",IND) 255 . S RIEN=DDATA(SUB,"IEN",JND) 256 . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"REM",RIEN)) 257 . I TEMP="" Q 258 . S STATUS=$P(TEMP,U,2) 259 . S DUE=$P(TEMP,U,3),DUE=$$EDATE^PXRMDATE(DUE) 260 . S LAST=$P(TEMP,U,4),LAST=$$EDATE^PXRMDATE(LAST) 261 . S NSP=38-$L(DDATA(SUB,"RNAME",JND)) 262 . S LINE=DDATA(SUB,"RNAME",JND)_$$INSCHR^PXRMEXLC(NSP," ")_STATUS 263 . S NSP=54-$L(LINE)-($L(DUE)/2) 264 . S LINE=LINE_$$INSCHR^PXRMEXLC(NSP," ")_DUE 265 . S NSP=69-$L(LINE)-($L(LAST)/2) 266 . S LINE=LINE_$$INSCHR^PXRMEXLC(NSP," ")_LAST 267 . D ADDTXT(LINE) 268 Q 269 ; 270 TITLE(PLIEN,DELIM) ;Print the report title. 271 N LISTNAME 272 S LISTNAME=$P(^PXRMXP(810.5,PLIEN,0),U,1) 273 I DELIM D 274 . W @IOF 275 . W !,"Patient Demographic Report" 276 . W !," Patient List: "_LISTNAME 277 . W !," Created on "_$$FMTE^XLFDT(DCREAT) 278 I 'DELIM D 279 . D ADDTXT("Patient Demographic Report") 280 . D ADDTXT(" Patient List: "_LISTNAME) 281 . D ADDTXT(" Created on "_$$FMTE^XLFDT(DCREAT)) 282 Q 283 ; 284 VADPTPR(DFN,DNAME,DTYPE,DDATA,SUB) ;Print data returned by a VADPT call. 285 N IND,JND,KND,LINE,LND,MAX,TEMP,TTEMP 286 D ADDTXT(" ") 287 D ADDTXT(DNAME) 288 S TEMP=$G(^TMP("PXRMPLD",$J,DFN,DTYPE)) 289 F IND=1:1:DDATA(SUB,"LEN") D 290 . S JND=$P(DDATA(SUB),",",IND) 291 . S KND="" 292 . F S KND=$O(DDATA(SUB,JND,KND)) Q:KND="" D 293 .. S TTEMP=$P(TEMP,U,KND) 294 .. S MAX=+$P(DDATA(SUB,JND,KND),U,3) 295 .. I MAX=0 S MAX=1 296 .. F LND=1:1:MAX D 297 ... S LINE=" "_$P(DDATA(SUB,JND,KND),U,1)_": "_$P(TTEMP,"~",LND) 298 ... D ADDTXT(LINE) 299 Q 300 ; 1 PXRMPDRP ;SLC/AGP,PKR - Patient List Demographic report print routine ;06/20/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ; 4 ADDTXT(TEXT) ;Accumulate text in ^TMP. 5 S LINCNT=LINCNT+1 6 S ^TMP("PXRMPDEM",$J,LINCNT)=TEXT 7 Q 8 ; 9 APPHDR(DC,APPDATA) ;Build the appointment header. 10 I APPDATA("LEN")'>0 Q 11 N HDR,IND,JND,KND,LND,TEMP 12 S IND=0,HDR="" 13 F IND=1:1:APPDATA("MAX") D 14 . F JND=1:1:APPDATA("LEN") D 15 .. S KND=$P(APPDATA,",",JND) 16 .. S LND="" 17 .. F S LND=$O(APPDATA(KND,LND)) Q:LND="" D 18 ... S TEMP=$P(APPDATA(KND,LND),U,1) 19 ... S HDR=HDR_TEMP_IND_DC 20 S APPDATA("HDR")=HDR 21 Q 22 ; 23 APPPRINT(DFN,APPDATA) ;Print appointment data. 24 N CLINIC,COUNT,DATE,HDR,IND,JND,KND,LINE,PCLINIC,PDATE,TEMP 25 S (PCLINIC,PDATE)=0 26 F IND=1:1:APPDATA("LEN") D 27 . S JND=$P(APPDATA,",",IND) 28 . I JND=1 S PDATE=1 29 . I JND=2 S PCLINIC=1 30 S HDR="" 31 I PDATE S HDR=" "_$P(APPDATA(1,1),U,1) 32 I PCLINIC S HDR=HDR_" "_$P(APPDATA(2,2),U,1) 33 D ADDTXT(" ") 34 D ADDTXT("Appointment Data") 35 D ADDTXT(HDR) 36 S COUNT=0 37 F S COUNT=$O(^TMP("PXRMPLD",$J,DFN,"APPDATA",COUNT)) Q:COUNT="" D 38 . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"APPDATA",COUNT)) 39 . S LINE="" 40 . I PDATE S LINE=LINE_$P(TEMP,U,1) 41 . I PCLINIC S LINE=LINE_" "_$P(TEMP,U,2) 42 . D ADDTXT(LINE) 43 Q 44 ; 45 DELIMHDR(DC,DATA) ;Build the delimited header for a data type. 46 I DATA("LEN")'>0 Q 47 N HDR,IND,JND,KND,LND,MAX,TEMP 48 S IND=0,HDR="" 49 F IND=1:1:DATA("LEN") D 50 . S JND=$P(DATA,",",IND) 51 . S KND="" 52 . F S KND=$O(DATA(JND,KND)) Q:KND="" D 53 .. S TEMP=$P(DATA(JND,KND),U,1) 54 .. S MAX=$P(DATA(JND,KND),U,3) 55 .. I MAX="" S HDR=HDR_TEMP_DC 56 .. I +MAX>0 F LND=1:1:MAX S HDR=HDR_TEMP_LND_DC 57 S DATA("HDR")=HDR 58 Q 59 ; 60 DELIMPR(DC,PLIEN,ADDDATA,APPDATA,DEMDATA,FINDDATA,INPDATA,PFACDATA,REMDATA) ; 61 ;Print the delimited report. 62 N DATALIST,DFN,IND,NDT,PNAME 63 S NDT=0 64 I ADDDATA("LEN")>0 S NDT=NDT+1,DATALIST(NDT)="ADDDATA" 65 I APPDATA("LEN")>0 S NDT=NDT+1,DATALIST(NDT)="APPDATA" 66 I DEMDATA("LEN")>0 S NDT=NDT+1,DATALIST(NDT)="DEMDATA" 67 I ELIGDATA("LEN")>0 S NDT=NDT+1,DATALIST(NDT)="ELIGDATA" 68 I FINDDATA("LEN")>0 S NDT=NDT+1,DATALIST(NDT)="FINDDATA" 69 I INPDATA("LEN")>0 S NDT=NDT+1,DATALIST(NDT)="INPDATA" 70 I PFACDATA("LEN")>0 S NDT=NDT+1,DATALIST(NDT)="PFACDATA" 71 I REMDATA("LEN")>0 S NDT=NDT+1,DATALIST(NDT)="REMDATA" 72 D TITLE(PLIEN,1) 73 ;Output the delimited header. 74 F IND=1:1:NDT D 75 . I DATALIST(IND)="ADDDATA" D DELIMHDR(DC,.ADDDATA) Q 76 . I DATALIST(IND)="APPDATA" D APPHDR(DC,.APPDATA) Q 77 . I DATALIST(IND)="DEMDATA" D DELIMHDR(DC,.DEMDATA) Q 78 . I DATALIST(IND)="ELIGDATA" D DELIMHDR(DC,.ELIGDATA) Q 79 . I DATALIST(IND)="FINDDATA" D DELIMHDR(DC,.FINDDATA) Q 80 . I DATALIST(IND)="INPDATA" D DELIMHDR(DC,.INPDATA) Q 81 . I DATALIST(IND)="PFACDATA" D PFACHDR(.PFACDATA) 82 . I DATALIST(IND)="REMDATA" D REMHDR(DC,.REMDATA) Q 83 D DELTITLE(DC,.ADDDATA,.APPDATA,.DEMDATA,.FINDDATA,.INPDATA,.PFACDATA,.REMDATA) 84 S PNAME=":" 85 F S PNAME=$O(^TMP("PXRMPLN",$J,PNAME)) Q:PNAME="" D 86 . S DFN="" 87 . F S DFN=$O(^TMP("PXRMPLN",$J,PNAME,DFN)) Q:DFN="" D 88 .. W !,PNAME_DC 89 .. F IND=1:1:NDT D 90 ... I DATALIST(IND)="ADDDATA" D PDELDATA(DFN,DC,DATALIST(IND),.ADDDATA) Q 91 ... I DATALIST(IND)="APPDATA" D PAPPDATA(DFN,DC,.APPDATA) Q 92 ... I DATALIST(IND)="DEMDATA" D PDELDATA(DFN,DC,DATALIST(IND),.DEMDATA) Q 93 ... I DATALIST(IND)="ELIGDATA" D PDELDATA(DFN,DC,DATALIST(IND),.ELIGDATA) Q 94 ... I DATALIST(IND)="FINDDATA" D PFINDATA(DFN,DC,.FINDDATA) Q 95 ... I DATALIST(IND)="INPDATA" D PDELDATA(DFN,DC,DATALIST(IND),.INPDATA) Q 96 ... I DATALIST(IND)="PFACDATA" D PFACDATA(DFN,.PFACDATA) Q 97 ... I DATALIST(IND)="REMDATA" D PREMDATA(DFN,DC,.REMDATA) Q 98 .. W "\\" 99 Q 100 ; 101 DELTITLE(DC,ADDDATA,APPDATA,DEMDATA,FINDDATA,INPDATA,PFACDATA,REMDATA) ;Combine 102 ;all the headers to create the delimited title. 103 W !,"PATIENT"_DC 104 W $G(ADDDATA("HDR")) 105 W $G(APPDATA("HDR")) 106 W $G(DEMDATA("HDR")) 107 W $G(ELIGDATA("HDR")) 108 W $G(FINDDATA("HDR")) 109 W $G(INPDATA("HDR")) 110 W $G(PFACDATA("HDR")) 111 W $G(REMDATA("HDR")) 112 W "\\" 113 Q 114 ; 115 FINDPR(DFN,FINDDATA) ;Print finding information. 116 N IND,JND,LINE,TEMP 117 D ADDTXT(" ") 118 S LINE="Finding Data" 119 D ADDTXT(LINE) 120 F IND=1:1:FINDDATA("LEN") D 121 . S JND=$P(FINDDATA,",",IND) 122 . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"FINDDATA",JND)) 123 . I TEMP="" Q 124 . S LINE=" "_$P(FINDDATA(JND,JND),U,1)_": "_TEMP 125 . D ADDTXT(LINE) 126 Q 127 ; 128 OUTPUT ;Output the text. 129 N IND,LC,LO,VSIZE 130 S VSIZE=IOSL-2 131 S (LC,LO)=0 132 F IND=1:1:LINCNT D 133 . S LC=LC+1,LO=LO+1 134 . W !,^TMP("PXRMPDEM",$J,LC) 135 . I LO=VSIZE D 136 .. D PAGE 137 .. I $D(DTOUT)!$D(DUOUT) S IND=LINCNT Q 138 .. S LO=0 139 Q 140 ; 141 PAGE ; 142 I ($E(IOST)="C")&(IO=IO(0)) D 143 . N DIR 144 . S DIR(0)="E" 145 . W ! 146 . D ^DIR K DIR 147 I $D(DUOUT)!$D(DTOUT) Q 148 W:$D(IOF) @IOF 149 I $E(IOST)="C",IO=IO(0) W @IOF 150 Q 151 ; 152 PAPPDATA(DFN,DC,APPDATA) ;Print the delimited appointment data. 153 N IND,JND,KND,LINE,LND,PIECE,TEMP 154 I APPDATA("LEN")'>0 Q 155 S LINE="" 156 F IND=1:1:APPDATA("MAX") D 157 . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"APPDATA",IND)) 158 . F JND=1:1:APPDATA("LEN") D 159 .. S KND=$P(APPDATA,",",JND) 160 .. S LND="" 161 .. F S LND=$O(APPDATA(KND,LND)) Q:LND="" D 162 ... S PIECE=$P(APPDATA(KND,KND),U,2) 163 ... S LINE=LINE_$P(TEMP,U,PIECE)_DC 164 W LINE 165 Q 166 ; 167 PDELDATA(DFN,DC,DTYPE,DATA) ;Print the delimited data. 168 N IND,JND,KND,LINE,LND,TEMP,TTEMP 169 I DATA("LEN")'>0 Q 170 S TEMP=$G(^TMP("PXRMPLD",$J,DFN,DTYPE)) 171 S LINE="" 172 F IND=1:1:DATA("LEN") D 173 . S JND=$P(DATA,",",IND) 174 . S KND="" 175 . F S KND=$O(DATA(JND,KND)) Q:KND="" D 176 .. S MAX=$P(DATA(JND,KND),U,3) 177 .. I MAX="" S LINE=LINE_$P(TEMP,U,KND)_DC Q 178 .. I +MAX>1 S TTEMP=$P(TEMP,U,KND) F LND=1:1:MAX S LINE=LINE_$P(TTEMP,"~",LND)_DC 179 W LINE 180 Q 181 ; 182 PFACHDR(PFACDATA) ;Build the preferred facility header. 183 I PFACDATA(0)=1 S PFACDATA("HDR")="PATIENT'S PREFERRED FACILITY" 184 Q 185 ; 186 PFACDATA(DFN,PFACDATA) ;Print the patient's preferred facility data, delimited. 187 I PFACDATA(0)=0 Q 188 W ^TMP("PXRMPLD",$J,DFN,"PFACDATA") 189 Q 190 ; 191 PFACPR(DFN,PFACDATA) ;Print the patient's preferred facility. 192 I PFACDATA(0)=0 Q 193 D ADDTXT("Patient's Preferred Facility") 194 D ADDTXT(" "_$G(^TMP("PXRMPLD",$J,DFN,"PFACDATA"))) 195 Q 196 ; 197 PFINDATA(DFN,DC,FINDDATA) ;Print the finding data. 198 N IND,JND,LINE,TEMP 199 I FINDDATA("LEN")'>0 Q 200 S LINE="" 201 F IND=1:1:FINDDATA("LEN") D 202 . S JND=$P(FINDDATA,",",IND) 203 . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"FINDDATA",JND)) 204 . S LINE=LINE_TEMP_DC 205 W LINE 206 Q 207 ; 208 PREMDATA(DFN,DC,REMDATA) ;Print the reminder data. 209 N IND,JND,LINE,TEMP 210 I REMDATA("LEN")'>0 Q 211 S LINE="" 212 F IND=1:1:REMDATA("LEN") D 213 . S JND=$P(REMDATA,",",IND) 214 . S LINE=LINE_REMDATA("RNAME",JND)_DC 215 . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"REMDATA",REMDATA("IEN",JND))) 216 . S LINE=LINE_$P(TEMP,U,2)_DC_$P(TEMP,U,3)_"^"_$P(TEMP,U,4)_DC 217 W LINE 218 Q 219 ; 220 REGPR(PLIEN,ADDDATA,APPDATA,DEMDATA,FINDDATA,INPDATA,PFACDATA,REMDATA) ; 221 ;Print the regular report.. 222 N DATATYPE,DFN,PNAME,LINCNT 223 K ^TMP("PXRMPDEM",$J) 224 S LINCNT=0 225 D TITLE(PLIEN,0) 226 S PNAME=":" 227 F S PNAME=$O(^TMP("PXRMPLN",$J,PNAME)) Q:PNAME="" D 228 . S DFN=0 229 . F S DFN=$O(^TMP("PXRMPLN",$J,PNAME,DFN)) Q:DFN="" D 230 .. D ADDTXT(" ") 231 .. D ADDTXT("---------- "_PNAME_" DFN="_DFN_" ----------") 232 .. S DATATYPE="" 233 .. F S DATATYPE=$O(^TMP("PXRMPLD",$J,DFN,DATATYPE)) Q:DATATYPE="" D 234 ... I DATATYPE="ADDDATA" D VADPTPR(DFN,"Address Data",DATATYPE,.ADDDATA) Q 235 ... I DATATYPE="APPDATA" D APPPRINT(DFN,.APPDATA) Q 236 ... I DATATYPE="DEMDATA" D VADPTPR(DFN,"Demographic Data",DATATYPE,.DEMDATA) Q 237 ... I DATATYPE="ELIGDATA" D VADPTPR(DFN,"Eligibility Data",DATATYPE,.ELIGDATA) Q 238 ... I DATATYPE="FINDDATA" D FINDPR(DFN,.FINDDATA) Q 239 ... I DATATYPE="INPDATA" D VADPTPR(DFN,"Inpatient Data",DATATYPE,.INPDATA) Q 240 ... I DATATYPE="PFACDATA" D PFACPR(DFN,.PFACDATA) Q 241 ... I DATATYPE="REMDATA" D REMPR(DFN,.REMDATA) Q 242 D OUTPUT 243 K ^TMP("PXRMPDEM",$J) 244 Q 245 ; 246 REMHDR(DC,REMDATA) ;Build the reminder data delimited header. 247 N HDR,IND,JND 248 S HDR="" 249 F IND=1:1:REMDATA("LEN") D 250 . S JND=$P(REMDATA,",",IND) 251 . S HDR=HDR_"REMINDER"_JND_DC_"STATUS"_JND_DC_"DUE DATE"_JND_DC_"LAST DONE"_JND_DC 252 S REMDATA("HDR")=HDR 253 Q 254 ; 255 REMPR(DFN,REMDATA) ;Print reminder status information. 256 N DUE,IND,JND,LAST,LINE,NSP,STATUS,TEMP 257 D ADDTXT(" ") 258 S LINE="Reminder:"_$$INSCHR^PXRMEXLC(27," ")_"--STATUS-- --DUE DATE-- --LAST DONE--" 259 D ADDTXT(LINE) 260 F IND=1:1:REMDATA("LEN") D 261 . S JND=$P(REMDATA,",",IND) 262 . S RIEN=REMDATA("IEN",JND) 263 . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"REMDATA",RIEN)) 264 . I TEMP="" Q 265 . S STATUS=$P(TEMP,U,2) 266 . S DUE=$P(TEMP,U,3),DUE=$$EDATE^PXRMDATE(DUE) 267 . S LAST=$P(TEMP,U,4),LAST=$$EDATE^PXRMDATE(LAST) 268 . S NSP=38-$L(REMDATA("RNAME",JND)) 269 . S LINE=REMDATA("RNAME",JND)_$$INSCHR^PXRMEXLC(NSP," ")_STATUS 270 . S NSP=54-$L(LINE)-($L(DUE)/2) 271 . S LINE=LINE_$$INSCHR^PXRMEXLC(NSP," ")_DUE 272 . S NSP=69-$L(LINE)-($L(LAST)/2) 273 . S LINE=LINE_$$INSCHR^PXRMEXLC(NSP," ")_LAST 274 . D ADDTXT(LINE) 275 Q 276 ; 277 TITLE(PLIEN,DELIM) ;Print the report title. 278 N LISTNAME 279 S LISTNAME=$P(^PXRMXP(810.5,PLIEN,0),U,1) 280 I DELIM D 281 . W @IOF 282 . W !,"Patient Demographic Report" 283 . W !," Patient List: "_LISTNAME 284 . W !," Created on "_$$FMTE^XLFDT(DCREAT) 285 I 'DELIM D 286 . D ADDTXT("Patient Demographic Report") 287 . D ADDTXT(" Patient List: "_LISTNAME) 288 . D ADDTXT(" Created on "_$$FMTE^XLFDT(DCREAT)) 289 Q 290 ; 291 VADPTPR(DFN,DNAME,DTYPE,DATA) ;Print data returned by a VADPT call. 292 N IND,JND,KND,LINE,LND,MAX,TEMP,TTEMP 293 D ADDTXT(" ") 294 D ADDTXT(DNAME) 295 S TEMP=$G(^TMP("PXRMPLD",$J,DFN,DTYPE)) 296 F IND=1:1:DATA("LEN") D 297 . S JND=$P(DATA,",",IND) 298 . S KND="" 299 . F S KND=$O(DATA(JND,KND)) Q:KND="" D 300 .. S TTEMP=$P(TEMP,U,KND) 301 .. S MAX=+$P(DATA(JND,KND),U,3) 302 .. I MAX=0 S MAX=1 303 .. F LND=1:1:MAX D 304 ... S LINE=" "_$P(DATA(JND,KND),U,1)_": "_$P(TTEMP,"~",LND) 305 ... D ADDTXT(LINE) 306 Q 307 ;
Note:
See TracChangeset
for help on using the changeset viewer.
