PXRMPDRP	;SLC/AGP,PKR - Patient List Demographic report print routine ;11/16/2007
	;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
	;
ADDTXT(TEXT)	;Accumulate text in ^TMP.
	S LINCNT=LINCNT+1
	S ^TMP("PXRMPDEM",$J,LINCNT)=TEXT
	Q
	;
APPHDR(DC,DDATA,SUB)	;Build the appointment header.
	I DDATA(SUB,"LEN")'>0 Q
	N HDR,IND,JND,KND,LND,TEMP
	S IND=0,HDR=""
	F IND=1:1:DDATA(SUB,"MAX") D
	. F JND=1:1:DDATA(SUB,"LEN") D
	.. S KND=$P(DDATA(SUB),",",JND)
	.. S LND=""
	.. F  S LND=$O(DDATA(SUB,KND,LND)) Q:LND=""  D
	... S TEMP=$P(DDATA(SUB,KND,LND),U,1)
	... S HDR=HDR_TEMP_IND_DC
	S DDATA(SUB,"HDR")=HDR
	Q
	;
APPPRINT(DFN,DDATA,SUB)	;Print appointment data.
	N CLINIC,COUNT,DATE,HDR,IND,JND,KND,LINE,PCLINIC,PDATE,TEMP
	S (PCLINIC,PDATE)=0
	F IND=1:1:DDATA(SUB,"LEN") D
	. S JND=$P(DDATA(SUB),",",IND)
	. I JND=1 S PDATE=1
	. I JND=2 S PCLINIC=1
	S HDR=""
	I PDATE S HDR=" "_$P(DDATA(SUB,1,1),U,1)
	I PCLINIC S HDR=HDR_"   "_$P(DDATA(SUB,2,2),U,1)
	D ADDTXT(" ")
	D ADDTXT("Appointment Data")
	D ADDTXT(HDR)
	S COUNT=0
	F  S COUNT=$O(^TMP("PXRMPLD",$J,DFN,"APP",COUNT)) Q:COUNT=""  D
	. S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"APP",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,DDATA,SUB)	;Build the delimited header for a data type.
	I DDATA(SUB,"LEN")'>0 Q
	N HDR,IND,JND,KND,LND,MAX,TEMP
	S IND=0,HDR=""
	F IND=1:1:DDATA(SUB,"LEN") D
	. S JND=$P(DDATA(SUB),",",IND)
	. S KND=""
	. F  S KND=$O(DDATA(SUB,JND,KND)) Q:KND=""  D
	.. S TEMP=$P(DDATA(SUB,JND,KND),U,1)
	.. S MAX=$P(DDATA(SUB,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 DDATA(SUB,"HDR")=HDR
	Q
	;
DELIMPR(DC,PLIEN,DDATA)	;
	;Print the delimited report.
	N DATALIST,DFN,IND,NDT,PNAME
	S NDT=0
	I DDATA("ADD","LEN")>0 S NDT=NDT+1,DATALIST(NDT)="ADD"
	I DDATA("APP","LEN")>0 S NDT=NDT+1,DATALIST(NDT)="APP"
	I DDATA("DEM","LEN")>0 S NDT=NDT+1,DATALIST(NDT)="DEM"
	I DDATA("ELIG","LEN")>0 S NDT=NDT+1,DATALIST(NDT)="ELIG"
	I DDATA("FIND","LEN")>0 S NDT=NDT+1,DATALIST(NDT)="FIND"
	I DDATA("INP","LEN")>0 S NDT=NDT+1,DATALIST(NDT)="INP"
	I DDATA("PFAC","LEN")>0 S NDT=NDT+1,DATALIST(NDT)="PFAC"
	I DDATA("REM","LEN")>0 S NDT=NDT+1,DATALIST(NDT)="REM"
	S DATALIST(0)=NDT
	D TITLE(PLIEN,1)
	;Create the delimited header.
	F IND=1:1:NDT D
	. I DATALIST(IND)="ADD" D DELIMHDR(DC,.DDATA,"ADD") Q
	. I DATALIST(IND)="APP" D APPHDR(DC,.DDATA,"APP") Q
	. I DATALIST(IND)="DEM" D DELIMHDR(DC,.DDATA,"DEM") Q
	. I DATALIST(IND)="ELIG" D DELIMHDR(DC,.DDATA,"ELIG") Q
	. I DATALIST(IND)="FIND" D DELIMHDR(DC,.DDATA,"FIND") Q
	. I DATALIST(IND)="INP" D DELIMHDR(DC,.DDATA,"INP") Q
	. I DATALIST(IND)="PFAC" D PFACHDR(.DDATA,"PFAC")
	. I DATALIST(IND)="REM" D REMHDR(DC,.DDATA,"REM") Q
	D DELTITLE(DC,.DATALIST,.DDATA)
	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)="ADD" D PDELDATA(DFN,DC,DATALIST(IND),.DDATA,"ADD") Q
	... I DATALIST(IND)="APP" D PAPPDATA(DFN,DC,.DDATA,"APP") Q
	... I DATALIST(IND)="DEM" D PDELDATA(DFN,DC,DATALIST(IND),.DDATA,"DEM") Q
	... I DATALIST(IND)="ELIG" D PDELDATA(DFN,DC,DATALIST(IND),.DDATA,"ELIG") Q
	... I DATALIST(IND)="FIND" D PFINDATA(DFN,DC,.DDATA,"FIND") Q
	... I DATALIST(IND)="INP" D PDELDATA(DFN,DC,DATALIST(IND),.DDATA,"INP") Q
	... I DATALIST(IND)="PFAC" D PFACDATA(DFN,.DDATA,"PFAC") Q
	... I DATALIST(IND)="REM" D PREMDATA(DFN,DC,.DDATA,"REM") Q
	.. W "\\"
	Q
	;
DELTITLE(DC,DATALIST,DDATA)	;Combine all the headers to create the delimited title.
	W !,"PATIENT"_DC
	N IND
	F IND=1:1:DATALIST(0) W DDATA(DATALIST(IND),"HDR")
	W "\\"
	Q
	;
FINDPR(DFN,DDATA,SUB)	;Print finding information.
	N IND,JND,LINE,TEMP
	D ADDTXT(" ")
	S LINE="Finding Data"
	D ADDTXT(LINE)
	F IND=1:1:DDATA(SUB,"LEN") D
	. S JND=$P(DDATA(SUB),",",IND)
	. S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"FIND",JND))
	. I TEMP="" Q
	. S LINE=" "_$P(DDATA(SUB,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,1,2)="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,1,2)="C-")&(IO=IO(0)) W @IOF
	Q
	;
PAPPDATA(DFN,DC,DDATA,SUB)	;Print the delimited appointment data.
	N IND,JND,KND,LINE,LND,PIECE,TEMP
	I DDATA(SUB,"LEN")'>0 Q
	S LINE=""
	F IND=1:1:DDATA(SUB,"MAX") D
	. S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"APP",IND))
	. F JND=1:1:DDATA(SUB,"LEN") D
	.. S KND=$P(DDATA(SUB),",",JND)
	.. S LND=""
	.. F  S LND=$O(DDATA(SUB,KND,LND)) Q:LND=""  D
	... S PIECE=$P(DDATA(SUB,KND,KND),U,2)
	... S LINE=LINE_$P(TEMP,U,PIECE)_DC
	W LINE
	Q
	;
PDELDATA(DFN,DC,DTYPE,DDATA,SUB)	;Print the delimited data.
	N IND,JND,KND,LINE,LND,TEMP,TTEMP
	S TEMP=$G(^TMP("PXRMPLD",$J,DFN,DTYPE))
	S LINE=""
	F IND=1:1:DDATA(DTYPE,"LEN") D
	. S JND=$P(DDATA(DTYPE),",",IND)
	. S KND=""
	. F  S KND=$O(DDATA(DTYPE,JND,KND)) Q:KND=""  D
	.. S MAX=$P(DDATA(DTYPE,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(DDATA,SUB)	;Build the preferred facility header.
	I DDATA(SUB,0)=1 S DDATA(SUB,"HDR")="PATIENT'S PREFERRED FACILITY"
	Q
	;
PFACDATA(DFN,DDATA,SUB)	;Print the patient's preferred facility data, delimited.
	I DDATA(SUB,0)=0 Q
	W ^TMP("PXRMPLD",$J,DFN,"PFAC")
	Q
	;
PFACPR(DFN,DDATA,SUB)	;Print the patient's preferred facility.
	I DDATA(SUB,0)=0 Q
	D ADDTXT("Patient's Preferred Facility")
	D ADDTXT(" "_$G(^TMP("PXRMPLD",$J,DFN,"PFAC")))
	Q
	;
PFINDATA(DFN,DC,DDATA,SUB)	;Print the finding data.
	N IND,JND,LINE,TEMP
	I DDATA(SUB,"LEN")'>0 Q
	S LINE=""
	F IND=1:1:DDATA(SUB,"LEN") D
	. S JND=$P(DDATA(SUB),",",IND)
	. S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"FIND",JND))
	. S LINE=LINE_TEMP_DC
	W LINE
	Q
	;
PREMDATA(DFN,DC,DDATA,SUB)	;Print the reminder data.
	N IND,JND,LINE,TEMP
	I DDATA(SUB,"LEN")'>0 Q
	S LINE=""
	F IND=1:1:DDATA(SUB,"LEN") D
	. S JND=$P(DDATA(SUB),",",IND)
	. S LINE=LINE_DDATA(SUB,"RNAME",JND)_DC
	. S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"REM",DDATA(SUB,"IEN",JND)))
	. S LINE=LINE_$P(TEMP,U,2)_DC_$P(TEMP,U,3)_"^"_$P(TEMP,U,4)_DC
	W LINE
	Q
	;
REGPR(PLIEN,DDATA,SUB)	;
	;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="ADD" D VADPTPR(DFN,"Address Data",DATATYPE,.DDATA,"ADD") Q
	... I DATATYPE="APP" D APPPRINT(DFN,.DDATA,"APP") Q
	... I DATATYPE="DEM" D VADPTPR(DFN,"Demographic Data",DATATYPE,.DDATA,"DEM") Q
	... I DATATYPE="ELIG" D VADPTPR(DFN,"Eligibility Data",DATATYPE,.DDATA,"ELIG") Q
	... I DATATYPE="FIND" D FINDPR(DFN,.DDATA,"FIND") Q
	... I DATATYPE="INP" D VADPTPR(DFN,"Inpatient Data",DATATYPE,.DDATA,"INP") Q
	... I DATATYPE="PFAC" D PFACPR(DFN,.DDATA,"PFAC") Q
	... I DATATYPE="REM" D REMPR(DFN,.DDATA,"REM") Q
	D OUTPUT
	K ^TMP("PXRMPDEM",$J)
	Q
	;
REMHDR(DC,DDATA,SUB)	;Build the reminder data delimited header.
	N HDR,IND,JND
	S HDR=""
	F IND=1:1:DDATA(SUB,"LEN") D
	. S JND=$P(DDATA(SUB),",",IND)
	. S HDR=HDR_"REMINDER"_JND_DC_"STATUS"_JND_DC_"DUE DATE"_JND_DC_"LAST DONE"_JND_DC
	S DDATA(SUB,"HDR")=HDR
	Q
	;
REMPR(DFN,DDATA,SUB)	;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:DDATA(SUB,"LEN") D
	. S JND=$P(DDATA(SUB),",",IND)
	. S RIEN=DDATA(SUB,"IEN",JND)
	. S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"REM",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(DDATA(SUB,"RNAME",JND))
	. S LINE=DDATA(SUB,"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,DDATA,SUB)	;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:DDATA(SUB,"LEN") D
	. S JND=$P(DDATA(SUB),",",IND)
	. S KND=""
	. F  S KND=$O(DDATA(SUB,JND,KND)) Q:KND=""  D
	.. S TTEMP=$P(TEMP,U,KND)
	.. S MAX=+$P(DDATA(SUB,JND,KND),U,3)
	.. I MAX=0 S MAX=1
	.. F LND=1:1:MAX D
	... S LINE=" "_$P(DDATA(SUB,JND,KND),U,1)_": "_$P(TTEMP,"~",LND)
	... D ADDTXT(LINE)
	Q
	;
