PXRMPDRP ;SLC/AGP,PKR - Patient List Demographic report print routine ;06/20/2006
 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
 ;
ADDTXT(TEXT) ;Accumulate text in ^TMP.
 S LINCNT=LINCNT+1
 S ^TMP("PXRMPDEM",$J,LINCNT)=TEXT
 Q
 ;
APPHDR(DC,APPDATA) ;Build the appointment header.
 I APPDATA("LEN")'>0 Q
 N HDR,IND,JND,KND,LND,TEMP
 S IND=0,HDR=""
 F IND=1:1:APPDATA("MAX") D
 . F JND=1:1:APPDATA("LEN") D
 .. S KND=$P(APPDATA,",",JND)
 .. S LND=""
 .. F  S LND=$O(APPDATA(KND,LND)) Q:LND=""  D
 ... S TEMP=$P(APPDATA(KND,LND),U,1)
 ... S HDR=HDR_TEMP_IND_DC
 S APPDATA("HDR")=HDR
 Q
 ;
APPPRINT(DFN,APPDATA) ;Print appointment data.
 N CLINIC,COUNT,DATE,HDR,IND,JND,KND,LINE,PCLINIC,PDATE,TEMP
 S (PCLINIC,PDATE)=0
 F IND=1:1:APPDATA("LEN") D
 . S JND=$P(APPDATA,",",IND)
 . I JND=1 S PDATE=1
 . I JND=2 S PCLINIC=1
 S HDR=""
 I PDATE S HDR=" "_$P(APPDATA(1,1),U,1)
 I PCLINIC S HDR=HDR_"   "_$P(APPDATA(2,2),U,1)
 D ADDTXT(" ")
 D ADDTXT("Appointment Data")
 D ADDTXT(HDR)
 S COUNT=0
 F  S COUNT=$O(^TMP("PXRMPLD",$J,DFN,"APPDATA",COUNT)) Q:COUNT=""  D
 . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"APPDATA",COUNT))
 . S LINE=""
 . I PDATE S LINE=LINE_$P(TEMP,U,1)
 . I PCLINIC S LINE=LINE_"  "_$P(TEMP,U,2)
 . D ADDTXT(LINE)
 Q
 ;
DELIMHDR(DC,DATA) ;Build the delimited header for a data type.
 I DATA("LEN")'>0 Q
 N HDR,IND,JND,KND,LND,MAX,TEMP
 S IND=0,HDR=""
 F IND=1:1:DATA("LEN") D
 . S JND=$P(DATA,",",IND)
 . S KND=""
 . F  S KND=$O(DATA(JND,KND)) Q:KND=""  D
 .. S TEMP=$P(DATA(JND,KND),U,1)
 .. S MAX=$P(DATA(JND,KND),U,3)
 .. I MAX="" S HDR=HDR_TEMP_DC
 .. I +MAX>0 F LND=1:1:MAX S HDR=HDR_TEMP_LND_DC
 S DATA("HDR")=HDR
 Q
 ;
DELIMPR(DC,PLIEN,ADDDATA,APPDATA,DEMDATA,FINDDATA,INPDATA,PFACDATA,REMDATA) ;
 ;Print the delimited report.
 N DATALIST,DFN,IND,NDT,PNAME
 S NDT=0
 I ADDDATA("LEN")>0 S NDT=NDT+1,DATALIST(NDT)="ADDDATA"
 I APPDATA("LEN")>0 S NDT=NDT+1,DATALIST(NDT)="APPDATA"
 I DEMDATA("LEN")>0 S NDT=NDT+1,DATALIST(NDT)="DEMDATA"
 I ELIGDATA("LEN")>0 S NDT=NDT+1,DATALIST(NDT)="ELIGDATA"
 I FINDDATA("LEN")>0 S NDT=NDT+1,DATALIST(NDT)="FINDDATA"
 I INPDATA("LEN")>0 S NDT=NDT+1,DATALIST(NDT)="INPDATA"
 I PFACDATA("LEN")>0 S NDT=NDT+1,DATALIST(NDT)="PFACDATA"
 I REMDATA("LEN")>0 S NDT=NDT+1,DATALIST(NDT)="REMDATA"
 D TITLE(PLIEN,1)
 ;Output the delimited header.
 F IND=1:1:NDT D
 . I DATALIST(IND)="ADDDATA" D DELIMHDR(DC,.ADDDATA) Q
 . I DATALIST(IND)="APPDATA" D APPHDR(DC,.APPDATA) Q
 . I DATALIST(IND)="DEMDATA" D DELIMHDR(DC,.DEMDATA) Q
 . I DATALIST(IND)="ELIGDATA" D DELIMHDR(DC,.ELIGDATA) Q
 . I DATALIST(IND)="FINDDATA" D DELIMHDR(DC,.FINDDATA) Q
 . I DATALIST(IND)="INPDATA" D DELIMHDR(DC,.INPDATA) Q
 . I DATALIST(IND)="PFACDATA" D PFACHDR(.PFACDATA)
 . I DATALIST(IND)="REMDATA" D REMHDR(DC,.REMDATA) Q
 D DELTITLE(DC,.ADDDATA,.APPDATA,.DEMDATA,.FINDDATA,.INPDATA,.PFACDATA,.REMDATA)
 S PNAME=":"
 F  S PNAME=$O(^TMP("PXRMPLN",$J,PNAME)) Q:PNAME=""  D
 . S DFN=""
 . F  S DFN=$O(^TMP("PXRMPLN",$J,PNAME,DFN)) Q:DFN=""  D
 .. W !,PNAME_DC
 .. F IND=1:1:NDT D
 ... I DATALIST(IND)="ADDDATA" D PDELDATA(DFN,DC,DATALIST(IND),.ADDDATA) Q
 ... I DATALIST(IND)="APPDATA" D PAPPDATA(DFN,DC,.APPDATA) Q
 ... I DATALIST(IND)="DEMDATA" D PDELDATA(DFN,DC,DATALIST(IND),.DEMDATA) Q
 ... I DATALIST(IND)="ELIGDATA" D PDELDATA(DFN,DC,DATALIST(IND),.ELIGDATA) Q
 ... I DATALIST(IND)="FINDDATA" D PFINDATA(DFN,DC,.FINDDATA) Q
 ... I DATALIST(IND)="INPDATA" D PDELDATA(DFN,DC,DATALIST(IND),.INPDATA) Q
 ... I DATALIST(IND)="PFACDATA" D PFACDATA(DFN,.PFACDATA) Q
 ... I DATALIST(IND)="REMDATA" D PREMDATA(DFN,DC,.REMDATA) Q
 .. W "\\"
 Q
 ;
DELTITLE(DC,ADDDATA,APPDATA,DEMDATA,FINDDATA,INPDATA,PFACDATA,REMDATA) ;Combine
 ;all the headers to create the delimited title.
 W !,"PATIENT"_DC
 W $G(ADDDATA("HDR"))
 W $G(APPDATA("HDR"))
 W $G(DEMDATA("HDR"))
 W $G(ELIGDATA("HDR"))
 W $G(FINDDATA("HDR"))
 W $G(INPDATA("HDR"))
 W $G(PFACDATA("HDR"))
 W $G(REMDATA("HDR"))
 W "\\"
 Q
 ;
FINDPR(DFN,FINDDATA) ;Print finding information.
 N IND,JND,LINE,TEMP
 D ADDTXT(" ")
 S LINE="Finding Data"
 D ADDTXT(LINE)
 F IND=1:1:FINDDATA("LEN") D
 . S JND=$P(FINDDATA,",",IND)
 . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"FINDDATA",JND))
 . I TEMP="" Q
 . S LINE=" "_$P(FINDDATA(JND,JND),U,1)_": "_TEMP
 . D ADDTXT(LINE)
 Q
 ;
OUTPUT ;Output the text.
 N IND,LC,LO,VSIZE
 S VSIZE=IOSL-2
 S (LC,LO)=0
 F IND=1:1:LINCNT D
 . S LC=LC+1,LO=LO+1
 . W !,^TMP("PXRMPDEM",$J,LC)
 . I LO=VSIZE D
 .. D PAGE
 .. I $D(DTOUT)!$D(DUOUT) S IND=LINCNT Q
 .. S LO=0
 Q
 ;
PAGE ;
 I ($E(IOST)="C")&(IO=IO(0)) D
 . N DIR
 . S DIR(0)="E"
 . W !
 . D ^DIR K DIR
 I $D(DUOUT)!$D(DTOUT) Q
 W:$D(IOF) @IOF
 I $E(IOST)="C",IO=IO(0) W @IOF
 Q
 ;
PAPPDATA(DFN,DC,APPDATA) ;Print the delimited appointment data.
 N IND,JND,KND,LINE,LND,PIECE,TEMP
 I APPDATA("LEN")'>0 Q
 S LINE=""
 F IND=1:1:APPDATA("MAX") D
 . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"APPDATA",IND))
 . F JND=1:1:APPDATA("LEN") D
 .. S KND=$P(APPDATA,",",JND)
 .. S LND=""
 .. F  S LND=$O(APPDATA(KND,LND)) Q:LND=""  D
 ... S PIECE=$P(APPDATA(KND,KND),U,2)
 ... S LINE=LINE_$P(TEMP,U,PIECE)_DC
 W LINE
 Q
 ;
PDELDATA(DFN,DC,DTYPE,DATA) ;Print the delimited data.
 N IND,JND,KND,LINE,LND,TEMP,TTEMP
 I DATA("LEN")'>0 Q
 S TEMP=$G(^TMP("PXRMPLD",$J,DFN,DTYPE))
 S LINE=""
 F IND=1:1:DATA("LEN") D
 . S JND=$P(DATA,",",IND)
 . S KND=""
 . F  S KND=$O(DATA(JND,KND)) Q:KND=""  D
 .. S MAX=$P(DATA(JND,KND),U,3)
 .. I MAX="" S LINE=LINE_$P(TEMP,U,KND)_DC Q
 .. I +MAX>1 S TTEMP=$P(TEMP,U,KND) F LND=1:1:MAX S LINE=LINE_$P(TTEMP,"~",LND)_DC
 W LINE
 Q
 ;
PFACHDR(PFACDATA) ;Build the preferred facility header.
 I PFACDATA(0)=1 S PFACDATA("HDR")="PATIENT'S PREFERRED FACILITY"
 Q
 ;
PFACDATA(DFN,PFACDATA) ;Print the patient's preferred facility data, delimited.
 I PFACDATA(0)=0 Q
 W ^TMP("PXRMPLD",$J,DFN,"PFACDATA")
 Q
 ;
PFACPR(DFN,PFACDATA) ;Print the patient's preferred facility.
 I PFACDATA(0)=0 Q
 D ADDTXT("Patient's Preferred Facility")
 D ADDTXT(" "_$G(^TMP("PXRMPLD",$J,DFN,"PFACDATA")))
 Q
 ;
PFINDATA(DFN,DC,FINDDATA) ;Print the finding data.
 N IND,JND,LINE,TEMP
 I FINDDATA("LEN")'>0 Q
 S LINE=""
 F IND=1:1:FINDDATA("LEN") D
 . S JND=$P(FINDDATA,",",IND)
 . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"FINDDATA",JND))
 . S LINE=LINE_TEMP_DC
 W LINE
 Q
 ;
PREMDATA(DFN,DC,REMDATA) ;Print the reminder data.
 N IND,JND,LINE,TEMP
 I REMDATA("LEN")'>0 Q
 S LINE=""
 F IND=1:1:REMDATA("LEN") D
 . S JND=$P(REMDATA,",",IND)
 . S LINE=LINE_REMDATA("RNAME",JND)_DC
 . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"REMDATA",REMDATA("IEN",JND)))
 . S LINE=LINE_$P(TEMP,U,2)_DC_$P(TEMP,U,3)_"^"_$P(TEMP,U,4)_DC
 W LINE
 Q
 ;
REGPR(PLIEN,ADDDATA,APPDATA,DEMDATA,FINDDATA,INPDATA,PFACDATA,REMDATA) ;
 ;Print the regular report..
 N DATATYPE,DFN,PNAME,LINCNT
 K ^TMP("PXRMPDEM",$J)
 S LINCNT=0
 D TITLE(PLIEN,0)
 S PNAME=":"
 F  S PNAME=$O(^TMP("PXRMPLN",$J,PNAME)) Q:PNAME=""  D
 . S DFN=0
 . F  S DFN=$O(^TMP("PXRMPLN",$J,PNAME,DFN)) Q:DFN=""  D
 .. D ADDTXT(" ")
 .. D ADDTXT("---------- "_PNAME_" DFN="_DFN_" ----------")
 .. S DATATYPE=""
 .. F  S DATATYPE=$O(^TMP("PXRMPLD",$J,DFN,DATATYPE)) Q:DATATYPE=""  D
 ... I DATATYPE="ADDDATA" D VADPTPR(DFN,"Address Data",DATATYPE,.ADDDATA) Q
 ... I DATATYPE="APPDATA" D APPPRINT(DFN,.APPDATA) Q
 ... I DATATYPE="DEMDATA" D VADPTPR(DFN,"Demographic Data",DATATYPE,.DEMDATA) Q
 ... I DATATYPE="ELIGDATA" D VADPTPR(DFN,"Eligibility Data",DATATYPE,.ELIGDATA) Q
 ... I DATATYPE="FINDDATA" D FINDPR(DFN,.FINDDATA) Q
 ... I DATATYPE="INPDATA" D VADPTPR(DFN,"Inpatient Data",DATATYPE,.INPDATA) Q
 ... I DATATYPE="PFACDATA" D PFACPR(DFN,.PFACDATA) Q
 ... I DATATYPE="REMDATA" D REMPR(DFN,.REMDATA) Q
 D OUTPUT
 K ^TMP("PXRMPDEM",$J)
 Q
 ;
REMHDR(DC,REMDATA) ;Build the reminder data delimited header.
 N HDR,IND,JND
 S HDR=""
 F IND=1:1:REMDATA("LEN") D
 . S JND=$P(REMDATA,",",IND)
 . S HDR=HDR_"REMINDER"_JND_DC_"STATUS"_JND_DC_"DUE DATE"_JND_DC_"LAST DONE"_JND_DC
 S REMDATA("HDR")=HDR
 Q
 ;
REMPR(DFN,REMDATA) ;Print reminder status information.
 N DUE,IND,JND,LAST,LINE,NSP,STATUS,TEMP
 D ADDTXT(" ")
 S LINE="Reminder:"_$$INSCHR^PXRMEXLC(27," ")_"--STATUS--  --DUE DATE--  --LAST DONE--"
 D ADDTXT(LINE)
 F IND=1:1:REMDATA("LEN") D
 . S JND=$P(REMDATA,",",IND)
 . S RIEN=REMDATA("IEN",JND)
 . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"REMDATA",RIEN))
 . I TEMP="" Q
 . S STATUS=$P(TEMP,U,2)
 . S DUE=$P(TEMP,U,3),DUE=$$EDATE^PXRMDATE(DUE)
 . S LAST=$P(TEMP,U,4),LAST=$$EDATE^PXRMDATE(LAST)
 . S NSP=38-$L(REMDATA("RNAME",JND))
 . S LINE=REMDATA("RNAME",JND)_$$INSCHR^PXRMEXLC(NSP," ")_STATUS
 . S NSP=54-$L(LINE)-($L(DUE)/2)
 . S LINE=LINE_$$INSCHR^PXRMEXLC(NSP," ")_DUE
 . S NSP=69-$L(LINE)-($L(LAST)/2)
 . S LINE=LINE_$$INSCHR^PXRMEXLC(NSP," ")_LAST
 . D ADDTXT(LINE)
 Q
 ;
TITLE(PLIEN,DELIM) ;Print the report title.
 N LISTNAME
 S LISTNAME=$P(^PXRMXP(810.5,PLIEN,0),U,1)
 I DELIM D
 . W @IOF
 . W !,"Patient Demographic Report"
 . W !,"   Patient List: "_LISTNAME
 . W !,"   Created on "_$$FMTE^XLFDT(DCREAT)
 I 'DELIM D
 . D ADDTXT("Patient Demographic Report")
 . D ADDTXT("   Patient List: "_LISTNAME)
 . D ADDTXT("   Created on "_$$FMTE^XLFDT(DCREAT))
 Q
 ;
VADPTPR(DFN,DNAME,DTYPE,DATA) ;Print data returned by a VADPT call.
 N IND,JND,KND,LINE,LND,MAX,TEMP,TTEMP
 D ADDTXT(" ")
 D ADDTXT(DNAME)
 S TEMP=$G(^TMP("PXRMPLD",$J,DFN,DTYPE))
 F IND=1:1:DATA("LEN") D
 . S JND=$P(DATA,",",IND)
 . S KND=""
 . F  S KND=$O(DATA(JND,KND)) Q:KND=""  D
 .. S TTEMP=$P(TEMP,U,KND)
 .. S MAX=+$P(DATA(JND,KND),U,3)
 .. I MAX=0 S MAX=1
 .. F LND=1:1:MAX D
 ... S LINE=" "_$P(DATA(JND,KND),U,1)_": "_$P(TTEMP,"~",LND)
 ... D ADDTXT(LINE)
 Q
 ;