- 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 Feb 18, 2025@23:14:51 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 ;