PXRMPDRP ;SLC/AGP,PKR - Patient List Demographic report print routine ;03/05/2015
;;2.0;CLINICAL REMINDERS;**4,6,12,18,47**;Feb 04, 2005;Build 291
;==========================================
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,DATE,HDR,IND,JND,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)
;The list has been set to the maximum length in PXRMPDR.
F IND=1:1:DDATA(SUB,"MAX") S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"APP",IND)) Q:TEMP="" D
. 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(DC,.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,.DDATA,"ADD") Q
... I DATALIST(IND)="APP" D PAPPDATA(DFN,DC,.DDATA,"APP") Q
... I DATALIST(IND)="DEM" D PDELDATA(DFN,DC,.DDATA,"DEM") Q
... I DATALIST(IND)="ELIG" D PDELDATA(DFN,DC,.DDATA,"ELIG") Q
... I DATALIST(IND)="FIND" D PFINDATA(DFN,DC,.DDATA,"FIND") Q
... I DATALIST(IND)="INP" D PDELDATA(DFN,DC,.DDATA,"INP") Q
... I DATALIST(IND)="PFAC" D PFACDATA(DFN,DC,.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,DDATA,SUB) ;Print the delimited data.
N IND,JND,KND,LINE,LND,MAX,TEMP,TTEMP
S TEMP=$G(^TMP("PXRMPLD",$J,DFN,SUB))
S LINE=""
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
..;KND is the piece number in TEMP
..;MAX is the number of occurrences to get.
.. S MAX=+$P(DDATA(SUB,JND,KND),U,3)
..;If MAX=0 just append the delimiter character.
.. I MAX=0 S LINE=LINE_$P(TEMP,U,KND)_DC Q
..;"~" is the within piece separator for multiple occurrences.
.. I MAX>0 S TTEMP=$P(TEMP,U,KND) F LND=1:1:MAX S LINE=LINE_$P(TTEMP,"~",LND)_DC
W LINE
Q
;
;==========================================
PFACHDR(DC,DDATA,SUB) ;Build the preferred facility header.
I DDATA(SUB,0)=1 S DDATA(SUB,"HDR")="PATIENT'S PREFERRED FACILITY"_DC
Q
;
;==========================================
PFACDATA(DFN,DC,DDATA,SUB) ;Print the patient's preferred facility data,
;delimited.
I DDATA(SUB,0)=0 Q
W ^TMP("PXRMPLD",$J,DFN,"PFAC")_DC
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,RIEN,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 DCREATE,LISTNAME
S LISTNAME=$P(^PXRMXP(810.5,PLIEN,0),U,1)
S DCREATE=$P(^PXRMXP(810.5,PLIEN,0),U,4)
I DELIM D
. W @IOF
. W !,"Patient Demographic Report"
. W !," Patient List: "_LISTNAME
. W !," Created on "_$$FMTE^XLFDT(DCREATE)
I 'DELIM D
. D ADDTXT("Patient Demographic Report")
. D ADDTXT(" Patient List: "_LISTNAME)
. D ADDTXT(" Created on "_$$FMTE^XLFDT(DCREATE))
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)
..;MAX is the number of occurrences to print.
.. 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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMPDRP 10881 printed Apr 09, 2024@20:49:25 Page 2
PXRMPDRP ;SLC/AGP,PKR - Patient List Demographic report print routine ;03/05/2015
+1 ;;2.0;CLINICAL REMINDERS;**4,6,12,18,47**;Feb 04, 2005;Build 291
+2 ;==========================================
ADDTXT(TEXT) ;Accumulate text in ^TMP.
+1 SET LINCNT=LINCNT+1
+2 SET ^TMP("PXRMPDEM",$JOB,LINCNT)=TEXT
+3 QUIT
+4 ;
+5 ;==========================================
APPHDR(DC,DDATA,SUB) ;Build the appointment header.
+1 IF DDATA(SUB,"LEN")'>0
QUIT
+2 NEW HDR,IND,JND,KND,LND,TEMP
+3 SET IND=0
SET HDR=""
+4 FOR IND=1:1:DDATA(SUB,"MAX")
Begin DoDot:1
+5 FOR JND=1:1:DDATA(SUB,"LEN")
Begin DoDot:2
+6 SET KND=$PIECE(DDATA(SUB),",",JND)
+7 SET LND=""
+8 FOR
SET LND=$ORDER(DDATA(SUB,KND,LND))
if LND=""
QUIT
Begin DoDot:3
+9 SET TEMP=$PIECE(DDATA(SUB,KND,LND),U,1)
+10 SET HDR=HDR_TEMP_IND_DC
End DoDot:3
End DoDot:2
End DoDot:1
+11 SET DDATA(SUB,"HDR")=HDR
+12 QUIT
+13 ;
+14 ;==========================================
APPPRINT(DFN,DDATA,SUB) ;Print appointment data.
+1 NEW CLINIC,DATE,HDR,IND,JND,LINE,PCLINIC,PDATE,TEMP
+2 SET (PCLINIC,PDATE)=0
+3 FOR IND=1:1:DDATA(SUB,"LEN")
Begin DoDot:1
+4 SET JND=$PIECE(DDATA(SUB),",",IND)
+5 IF JND=1
SET PDATE=1
+6 IF JND=2
SET PCLINIC=1
End DoDot:1
+7 SET HDR=""
+8 IF PDATE
SET HDR=" "_$PIECE(DDATA(SUB,1,1),U,1)
+9 IF PCLINIC
SET HDR=HDR_" "_$PIECE(DDATA(SUB,2,2),U,1)
+10 DO ADDTXT(" ")
+11 DO ADDTXT("Appointment Data")
+12 DO ADDTXT(HDR)
+13 ;The list has been set to the maximum length in PXRMPDR.
+14 FOR IND=1:1:DDATA(SUB,"MAX")
SET TEMP=$GET(^TMP("PXRMPLD",$JOB,DFN,"APP",IND))
if TEMP=""
QUIT
Begin DoDot:1
+15 SET LINE=""
+16 IF PDATE
SET LINE=LINE_$PIECE(TEMP,U,1)
+17 IF PCLINIC
SET LINE=LINE_" "_$PIECE(TEMP,U,2)
+18 DO ADDTXT(LINE)
End DoDot:1
+19 QUIT
+20 ;
+21 ;==========================================
DELIMHDR(DC,DDATA,SUB) ;Build the delimited header for a data type.
+1 IF DDATA(SUB,"LEN")'>0
QUIT
+2 NEW HDR,IND,JND,KND,LND,MAX,TEMP
+3 SET IND=0
SET HDR=""
+4 FOR IND=1:1:DDATA(SUB,"LEN")
Begin DoDot:1
+5 SET JND=$PIECE(DDATA(SUB),",",IND)
+6 SET KND=""
+7 FOR
SET KND=$ORDER(DDATA(SUB,JND,KND))
if KND=""
QUIT
Begin DoDot:2
+8 SET TEMP=$PIECE(DDATA(SUB,JND,KND),U,1)
+9 SET MAX=$PIECE(DDATA(SUB,JND,KND),U,3)
+10 IF MAX=""
SET HDR=HDR_TEMP_DC
+11 IF +MAX>0
FOR LND=1:1:MAX
SET HDR=HDR_TEMP_LND_DC
End DoDot:2
End DoDot:1
+12 SET DDATA(SUB,"HDR")=HDR
+13 QUIT
+14 ;
+15 ;==========================================
DELIMPR(DC,PLIEN,DDATA) ;
+1 ;Print the delimited report.
+2 NEW DATALIST,DFN,IND,NDT,PNAME
+3 SET NDT=0
+4 IF DDATA("ADD","LEN")>0
SET NDT=NDT+1
SET DATALIST(NDT)="ADD"
+5 IF DDATA("APP","LEN")>0
SET NDT=NDT+1
SET DATALIST(NDT)="APP"
+6 IF DDATA("DEM","LEN")>0
SET NDT=NDT+1
SET DATALIST(NDT)="DEM"
+7 IF DDATA("ELIG","LEN")>0
SET NDT=NDT+1
SET DATALIST(NDT)="ELIG"
+8 IF DDATA("FIND","LEN")>0
SET NDT=NDT+1
SET DATALIST(NDT)="FIND"
+9 IF DDATA("INP","LEN")>0
SET NDT=NDT+1
SET DATALIST(NDT)="INP"
+10 IF DDATA("PFAC","LEN")>0
SET NDT=NDT+1
SET DATALIST(NDT)="PFAC"
+11 IF DDATA("REM","LEN")>0
SET NDT=NDT+1
SET DATALIST(NDT)="REM"
+12 SET DATALIST(0)=NDT
+13 DO TITLE(PLIEN,1)
+14 ;Create the delimited header.
+15 FOR IND=1:1:NDT
Begin DoDot:1
+16 IF DATALIST(IND)="ADD"
DO DELIMHDR(DC,.DDATA,"ADD")
QUIT
+17 IF DATALIST(IND)="APP"
DO APPHDR(DC,.DDATA,"APP")
QUIT
+18 IF DATALIST(IND)="DEM"
DO DELIMHDR(DC,.DDATA,"DEM")
QUIT
+19 IF DATALIST(IND)="ELIG"
DO DELIMHDR(DC,.DDATA,"ELIG")
QUIT
+20 IF DATALIST(IND)="FIND"
DO DELIMHDR(DC,.DDATA,"FIND")
QUIT
+21 IF DATALIST(IND)="INP"
DO DELIMHDR(DC,.DDATA,"INP")
QUIT
+22 IF DATALIST(IND)="PFAC"
DO PFACHDR(DC,.DDATA,"PFAC")
+23 IF DATALIST(IND)="REM"
DO REMHDR(DC,.DDATA,"REM")
QUIT
End DoDot:1
+24 DO DELTITLE(DC,.DATALIST,.DDATA)
+25 SET PNAME=":"
+26 FOR
SET PNAME=$ORDER(^TMP("PXRMPLN",$JOB,PNAME))
if PNAME=""
QUIT
Begin DoDot:1
+27 SET DFN=""
+28 FOR
SET DFN=$ORDER(^TMP("PXRMPLN",$JOB,PNAME,DFN))
if DFN=""
QUIT
Begin DoDot:2
+29 WRITE !,PNAME_DC
+30 FOR IND=1:1:NDT
Begin DoDot:3
+31 IF DATALIST(IND)="ADD"
DO PDELDATA(DFN,DC,.DDATA,"ADD")
QUIT
+32 IF DATALIST(IND)="APP"
DO PAPPDATA(DFN,DC,.DDATA,"APP")
QUIT
+33 IF DATALIST(IND)="DEM"
DO PDELDATA(DFN,DC,.DDATA,"DEM")
QUIT
+34 IF DATALIST(IND)="ELIG"
DO PDELDATA(DFN,DC,.DDATA,"ELIG")
QUIT
+35 IF DATALIST(IND)="FIND"
DO PFINDATA(DFN,DC,.DDATA,"FIND")
QUIT
+36 IF DATALIST(IND)="INP"
DO PDELDATA(DFN,DC,.DDATA,"INP")
QUIT
+37 IF DATALIST(IND)="PFAC"
DO PFACDATA(DFN,DC,.DDATA,"PFAC")
QUIT
+38 IF DATALIST(IND)="REM"
DO PREMDATA(DFN,DC,.DDATA,"REM")
QUIT
End DoDot:3
+39 WRITE "\\"
End DoDot:2
End DoDot:1
+40 QUIT
+41 ;
+42 ;==========================================
DELTITLE(DC,DATALIST,DDATA) ;Combine all the headers to create the delimited title.
+1 WRITE !,"PATIENT"_DC
+2 NEW IND
+3 FOR IND=1:1:DATALIST(0)
WRITE DDATA(DATALIST(IND),"HDR")
+4 WRITE "\\"
+5 QUIT
+6 ;
+7 ;==========================================
FINDPR(DFN,DDATA,SUB) ;Print finding information.
+1 NEW IND,JND,LINE,TEMP
+2 DO ADDTXT(" ")
+3 SET LINE="Finding Data"
+4 DO ADDTXT(LINE)
+5 FOR IND=1:1:DDATA(SUB,"LEN")
Begin DoDot:1
+6 SET JND=$PIECE(DDATA(SUB),",",IND)
+7 SET TEMP=$GET(^TMP("PXRMPLD",$JOB,DFN,"FIND",JND))
+8 IF TEMP=""
QUIT
+9 SET LINE=" "_$PIECE(DDATA(SUB,JND,JND),U,1)_": "_TEMP
+10 DO ADDTXT(LINE)
End DoDot:1
+11 QUIT
+12 ;
+13 ;==========================================
OUTPUT ;Output the text.
+1 NEW IND,LC,LO,VSIZE
+2 SET VSIZE=IOSL-2
+3 SET (LC,LO)=0
+4 FOR IND=1:1:LINCNT
Begin DoDot:1
+5 SET LC=LC+1
SET LO=LO+1
+6 WRITE !,^TMP("PXRMPDEM",$JOB,LC)
+7 IF LO=VSIZE
Begin DoDot:2
+8 DO PAGE
+9 IF $DATA(DTOUT)!$DATA(DUOUT)
SET IND=LINCNT
QUIT
+10 SET LO=0
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
+13 ;==========================================
PAGE ;
+1 IF ($EXTRACT(IOST,1,2)="C-")&(IO=IO(0))
Begin DoDot:1
+2 NEW DIR
+3 SET DIR(0)="E"
+4 WRITE !
+5 DO ^DIR
KILL DIR
End DoDot:1
+6 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+7 if $DATA(IOF)
WRITE @IOF
+8 IF ($EXTRACT(IOST,1,2)="C-")&(IO=IO(0))
WRITE @IOF
+9 QUIT
+10 ;
+11 ;==========================================
PAPPDATA(DFN,DC,DDATA,SUB) ;Print the delimited appointment data.
+1 NEW IND,JND,KND,LINE,LND,PIECE,TEMP
+2 IF DDATA(SUB,"LEN")'>0
QUIT
+3 SET LINE=""
+4 FOR IND=1:1:DDATA(SUB,"MAX")
Begin DoDot:1
+5 SET TEMP=$GET(^TMP("PXRMPLD",$JOB,DFN,"APP",IND))
+6 FOR JND=1:1:DDATA(SUB,"LEN")
Begin DoDot:2
+7 SET KND=$PIECE(DDATA(SUB),",",JND)
+8 SET LND=""
+9 FOR
SET LND=$ORDER(DDATA(SUB,KND,LND))
if LND=""
QUIT
Begin DoDot:3
+10 SET PIECE=$PIECE(DDATA(SUB,KND,KND),U,2)
+11 SET LINE=LINE_$PIECE(TEMP,U,PIECE)_DC
End DoDot:3
End DoDot:2
End DoDot:1
+12 WRITE LINE
+13 QUIT
+14 ;
+15 ;==========================================
PDELDATA(DFN,DC,DDATA,SUB) ;Print the delimited data.
+1 NEW IND,JND,KND,LINE,LND,MAX,TEMP,TTEMP
+2 SET TEMP=$GET(^TMP("PXRMPLD",$JOB,DFN,SUB))
+3 SET LINE=""
+4 FOR IND=1:1:DDATA(SUB,"LEN")
Begin DoDot:1
+5 SET JND=$PIECE(DDATA(SUB),",",IND)
+6 SET KND=""
+7 FOR
SET KND=$ORDER(DDATA(SUB,JND,KND))
if KND=""
QUIT
Begin DoDot:2
+8 ;KND is the piece number in TEMP
+9 ;MAX is the number of occurrences to get.
+10 SET MAX=+$PIECE(DDATA(SUB,JND,KND),U,3)
+11 ;If MAX=0 just append the delimiter character.
+12 IF MAX=0
SET LINE=LINE_$PIECE(TEMP,U,KND)_DC
QUIT
+13 ;"~" is the within piece separator for multiple occurrences.
+14 IF MAX>0
SET TTEMP=$PIECE(TEMP,U,KND)
FOR LND=1:1:MAX
SET LINE=LINE_$PIECE(TTEMP,"~",LND)_DC
End DoDot:2
End DoDot:1
+15 WRITE LINE
+16 QUIT
+17 ;
+18 ;==========================================
PFACHDR(DC,DDATA,SUB) ;Build the preferred facility header.
+1 IF DDATA(SUB,0)=1
SET DDATA(SUB,"HDR")="PATIENT'S PREFERRED FACILITY"_DC
+2 QUIT
+3 ;
+4 ;==========================================
PFACDATA(DFN,DC,DDATA,SUB) ;Print the patient's preferred facility data,
+1 ;delimited.
+2 IF DDATA(SUB,0)=0
QUIT
+3 WRITE ^TMP("PXRMPLD",$JOB,DFN,"PFAC")_DC
+4 QUIT
+5 ;
+6 ;==========================================
PFACPR(DFN,DDATA,SUB) ;Print the patient's preferred facility.
+1 IF DDATA(SUB,0)=0
QUIT
+2 DO ADDTXT("Patient's Preferred Facility")
+3 DO ADDTXT(" "_$GET(^TMP("PXRMPLD",$JOB,DFN,"PFAC")))
+4 QUIT
+5 ;
+6 ;==========================================
PFINDATA(DFN,DC,DDATA,SUB) ;Print the finding data.
+1 NEW IND,JND,LINE,TEMP
+2 IF DDATA(SUB,"LEN")'>0
QUIT
+3 SET LINE=""
+4 FOR IND=1:1:DDATA(SUB,"LEN")
Begin DoDot:1
+5 SET JND=$PIECE(DDATA(SUB),",",IND)
+6 SET TEMP=$GET(^TMP("PXRMPLD",$JOB,DFN,"FIND",JND))
+7 SET LINE=LINE_TEMP_DC
End DoDot:1
+8 WRITE LINE
+9 QUIT
+10 ;
+11 ;==========================================
PREMDATA(DFN,DC,DDATA,SUB) ;Print the reminder data.
+1 NEW IND,JND,LINE,TEMP
+2 IF DDATA(SUB,"LEN")'>0
QUIT
+3 SET LINE=""
+4 FOR IND=1:1:DDATA(SUB,"LEN")
Begin DoDot:1
+5 SET JND=$PIECE(DDATA(SUB),",",IND)
+6 SET LINE=LINE_DDATA(SUB,"RNAME",JND)_DC
+7 SET TEMP=$GET(^TMP("PXRMPLD",$JOB,DFN,"REM",DDATA(SUB,"IEN",JND)))
+8 SET LINE=LINE_$PIECE(TEMP,U,2)_DC_$PIECE(TEMP,U,3)_"^"_$PIECE(TEMP,U,4)_DC
End DoDot:1
+9 WRITE LINE
+10 QUIT
+11 ;
+12 ;==========================================
REGPR(PLIEN,DDATA,SUB) ;
+1 ;Print the regular report..
+2 NEW DATATYPE,DFN,PNAME,LINCNT
+3 KILL ^TMP("PXRMPDEM",$JOB)
+4 SET LINCNT=0
+5 DO TITLE(PLIEN,0)
+6 SET PNAME=":"
+7 FOR
SET PNAME=$ORDER(^TMP("PXRMPLN",$JOB,PNAME))
if PNAME=""
QUIT
Begin DoDot:1
+8 SET DFN=0
+9 FOR
SET DFN=$ORDER(^TMP("PXRMPLN",$JOB,PNAME,DFN))
if DFN=""
QUIT
Begin DoDot:2
+10 DO ADDTXT(" ")
+11 DO ADDTXT("---------- "_PNAME_" DFN="_DFN_" ----------")
+12 SET DATATYPE=""
+13 FOR
SET DATATYPE=$ORDER(^TMP("PXRMPLD",$JOB,DFN,DATATYPE))
if DATATYPE=""
QUIT
Begin DoDot:3
+14 IF DATATYPE="ADD"
DO VADPTPR(DFN,"Address Data",DATATYPE,.DDATA,"ADD")
QUIT
+15 IF DATATYPE="APP"
DO APPPRINT(DFN,.DDATA,"APP")
QUIT
+16 IF DATATYPE="DEM"
DO VADPTPR(DFN,"Demographic Data",DATATYPE,.DDATA,"DEM")
QUIT
+17 IF DATATYPE="ELIG"
DO VADPTPR(DFN,"Eligibility Data",DATATYPE,.DDATA,"ELIG")
QUIT
+18 IF DATATYPE="FIND"
DO FINDPR(DFN,.DDATA,"FIND")
QUIT
+19 IF DATATYPE="INP"
DO VADPTPR(DFN,"Inpatient Data",DATATYPE,.DDATA,"INP")
QUIT
+20 IF DATATYPE="PFAC"
DO PFACPR(DFN,.DDATA,"PFAC")
QUIT
+21 IF DATATYPE="REM"
DO REMPR(DFN,.DDATA,"REM")
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+22 DO OUTPUT
+23 KILL ^TMP("PXRMPDEM",$JOB)
+24 QUIT
+25 ;
+26 ;==========================================
REMHDR(DC,DDATA,SUB) ;Build the reminder data delimited header.
+1 NEW HDR,IND,JND
+2 SET HDR=""
+3 FOR IND=1:1:DDATA(SUB,"LEN")
Begin DoDot:1
+4 SET JND=$PIECE(DDATA(SUB),",",IND)
+5 SET HDR=HDR_"REMINDER"_JND_DC_"STATUS"_JND_DC_"DUE DATE"_JND_DC_"LAST DONE"_JND_DC
End DoDot:1
+6 SET DDATA(SUB,"HDR")=HDR
+7 QUIT
+8 ;
+9 ;==========================================
REMPR(DFN,DDATA,SUB) ;Print reminder status information.
+1 NEW DUE,IND,JND,LAST,LINE,NSP,RIEN,STATUS,TEMP
+2 DO ADDTXT(" ")
+3 SET LINE="Reminder:"_$$INSCHR^PXRMEXLC(27," ")_"--STATUS-- --DUE DATE-- --LAST DONE--"
+4 DO ADDTXT(LINE)
+5 FOR IND=1:1:DDATA(SUB,"LEN")
Begin DoDot:1
+6 SET JND=$PIECE(DDATA(SUB),",",IND)
+7 SET RIEN=DDATA(SUB,"IEN",JND)
+8 SET TEMP=$GET(^TMP("PXRMPLD",$JOB,DFN,"REM",RIEN))
+9 IF TEMP=""
QUIT
+10 SET STATUS=$PIECE(TEMP,U,2)
+11 SET DUE=$PIECE(TEMP,U,3)
SET DUE=$$EDATE^PXRMDATE(DUE)
+12 SET LAST=$PIECE(TEMP,U,4)
SET LAST=$$EDATE^PXRMDATE(LAST)
+13 SET NSP=38-$LENGTH(DDATA(SUB,"RNAME",JND))
+14 SET LINE=DDATA(SUB,"RNAME",JND)_$$INSCHR^PXRMEXLC(NSP," ")_STATUS
+15 SET NSP=54-$LENGTH(LINE)-($LENGTH(DUE)/2)
+16 SET LINE=LINE_$$INSCHR^PXRMEXLC(NSP," ")_DUE
+17 SET NSP=69-$LENGTH(LINE)-($LENGTH(LAST)/2)
+18 SET LINE=LINE_$$INSCHR^PXRMEXLC(NSP," ")_LAST
+19 DO ADDTXT(LINE)
End DoDot:1
+20 QUIT
+21 ;
+22 ;==========================================
TITLE(PLIEN,DELIM) ;Print the report title.
+1 NEW DCREATE,LISTNAME
+2 SET LISTNAME=$PIECE(^PXRMXP(810.5,PLIEN,0),U,1)
+3 SET DCREATE=$PIECE(^PXRMXP(810.5,PLIEN,0),U,4)
+4 IF DELIM
Begin DoDot:1
+5 WRITE @IOF
+6 WRITE !,"Patient Demographic Report"
+7 WRITE !," Patient List: "_LISTNAME
+8 WRITE !," Created on "_$$FMTE^XLFDT(DCREATE)
End DoDot:1
+9 IF 'DELIM
Begin DoDot:1
+10 DO ADDTXT("Patient Demographic Report")
+11 DO ADDTXT(" Patient List: "_LISTNAME)
+12 DO ADDTXT(" Created on "_$$FMTE^XLFDT(DCREATE))
End DoDot:1
+13 QUIT
+14 ;
+15 ;==========================================
VADPTPR(DFN,DNAME,DTYPE,DDATA,SUB) ;Print data returned by a VADPT call.
+1 NEW IND,JND,KND,LINE,LND,MAX,TEMP,TTEMP
+2 DO ADDTXT(" ")
+3 DO ADDTXT(DNAME)
+4 SET TEMP=$GET(^TMP("PXRMPLD",$JOB,DFN,DTYPE))
+5 FOR IND=1:1:DDATA(SUB,"LEN")
Begin DoDot:1
+6 SET JND=$PIECE(DDATA(SUB),",",IND)
+7 SET KND=""
+8 FOR
SET KND=$ORDER(DDATA(SUB,JND,KND))
if KND=""
QUIT
Begin DoDot:2
+9 SET TTEMP=$PIECE(TEMP,U,KND)
+10 ;MAX is the number of occurrences to print.
+11 SET MAX=+$PIECE(DDATA(SUB,JND,KND),U,3)
+12 IF MAX=0
SET MAX=1
+13 FOR LND=1:1:MAX
Begin DoDot:3
+14 SET LINE=" "_$PIECE(DDATA(SUB,JND,KND),U,1)_": "_$PIECE(TTEMP,"~",LND)
+15 DO ADDTXT(LINE)
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
