Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMPDRP

PXRMPDRP.m

Go to the documentation of this file.
  1. 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
  1. ;==========================================
  1. ADDTXT(TEXT) ;Accumulate text in ^TMP.
  1. S LINCNT=LINCNT+1
  1. S ^TMP("PXRMPDEM",$J,LINCNT)=TEXT
  1. Q
  1. ;
  1. ;==========================================
  1. APPHDR(DC,DDATA,SUB) ;Build the appointment header.
  1. I DDATA(SUB,"LEN")'>0 Q
  1. N HDR,IND,JND,KND,LND,TEMP
  1. S IND=0,HDR=""
  1. F IND=1:1:DDATA(SUB,"MAX") D
  1. . F JND=1:1:DDATA(SUB,"LEN") D
  1. .. S KND=$P(DDATA(SUB),",",JND)
  1. .. S LND=""
  1. .. F S LND=$O(DDATA(SUB,KND,LND)) Q:LND="" D
  1. ... S TEMP=$P(DDATA(SUB,KND,LND),U,1)
  1. ... S HDR=HDR_TEMP_IND_DC
  1. S DDATA(SUB,"HDR")=HDR
  1. Q
  1. ;
  1. ;==========================================
  1. APPPRINT(DFN,DDATA,SUB) ;Print appointment data.
  1. N CLINIC,DATE,HDR,IND,JND,LINE,PCLINIC,PDATE,TEMP
  1. S (PCLINIC,PDATE)=0
  1. F IND=1:1:DDATA(SUB,"LEN") D
  1. . S JND=$P(DDATA(SUB),",",IND)
  1. . I JND=1 S PDATE=1
  1. . I JND=2 S PCLINIC=1
  1. S HDR=""
  1. I PDATE S HDR=" "_$P(DDATA(SUB,1,1),U,1)
  1. I PCLINIC S HDR=HDR_" "_$P(DDATA(SUB,2,2),U,1)
  1. D ADDTXT(" ")
  1. D ADDTXT("Appointment Data")
  1. D ADDTXT(HDR)
  1. ;The list has been set to the maximum length in PXRMPDR.
  1. F IND=1:1:DDATA(SUB,"MAX") S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"APP",IND)) Q:TEMP="" D
  1. . S LINE=""
  1. . I PDATE S LINE=LINE_$P(TEMP,U,1)
  1. . I PCLINIC S LINE=LINE_" "_$P(TEMP,U,2)
  1. . D ADDTXT(LINE)
  1. Q
  1. ;
  1. ;==========================================
  1. DELIMHDR(DC,DDATA,SUB) ;Build the delimited header for a data type.
  1. I DDATA(SUB,"LEN")'>0 Q
  1. N HDR,IND,JND,KND,LND,MAX,TEMP
  1. S IND=0,HDR=""
  1. F IND=1:1:DDATA(SUB,"LEN") D
  1. . S JND=$P(DDATA(SUB),",",IND)
  1. . S KND=""
  1. . F S KND=$O(DDATA(SUB,JND,KND)) Q:KND="" D
  1. .. S TEMP=$P(DDATA(SUB,JND,KND),U,1)
  1. .. S MAX=$P(DDATA(SUB,JND,KND),U,3)
  1. .. I MAX="" S HDR=HDR_TEMP_DC
  1. .. I +MAX>0 F LND=1:1:MAX S HDR=HDR_TEMP_LND_DC
  1. S DDATA(SUB,"HDR")=HDR
  1. Q
  1. ;
  1. ;==========================================
  1. DELIMPR(DC,PLIEN,DDATA) ;
  1. ;Print the delimited report.
  1. N DATALIST,DFN,IND,NDT,PNAME
  1. S NDT=0
  1. I DDATA("ADD","LEN")>0 S NDT=NDT+1,DATALIST(NDT)="ADD"
  1. I DDATA("APP","LEN")>0 S NDT=NDT+1,DATALIST(NDT)="APP"
  1. I DDATA("DEM","LEN")>0 S NDT=NDT+1,DATALIST(NDT)="DEM"
  1. I DDATA("ELIG","LEN")>0 S NDT=NDT+1,DATALIST(NDT)="ELIG"
  1. I DDATA("FIND","LEN")>0 S NDT=NDT+1,DATALIST(NDT)="FIND"
  1. I DDATA("INP","LEN")>0 S NDT=NDT+1,DATALIST(NDT)="INP"
  1. I DDATA("PFAC","LEN")>0 S NDT=NDT+1,DATALIST(NDT)="PFAC"
  1. I DDATA("REM","LEN")>0 S NDT=NDT+1,DATALIST(NDT)="REM"
  1. S DATALIST(0)=NDT
  1. D TITLE(PLIEN,1)
  1. ;Create the delimited header.
  1. F IND=1:1:NDT D
  1. . I DATALIST(IND)="ADD" D DELIMHDR(DC,.DDATA,"ADD") Q
  1. . I DATALIST(IND)="APP" D APPHDR(DC,.DDATA,"APP") Q
  1. . I DATALIST(IND)="DEM" D DELIMHDR(DC,.DDATA,"DEM") Q
  1. . I DATALIST(IND)="ELIG" D DELIMHDR(DC,.DDATA,"ELIG") Q
  1. . I DATALIST(IND)="FIND" D DELIMHDR(DC,.DDATA,"FIND") Q
  1. . I DATALIST(IND)="INP" D DELIMHDR(DC,.DDATA,"INP") Q
  1. . I DATALIST(IND)="PFAC" D PFACHDR(DC,.DDATA,"PFAC")
  1. . I DATALIST(IND)="REM" D REMHDR(DC,.DDATA,"REM") Q
  1. D DELTITLE(DC,.DATALIST,.DDATA)
  1. S PNAME=":"
  1. F S PNAME=$O(^TMP("PXRMPLN",$J,PNAME)) Q:PNAME="" D
  1. . S DFN=""
  1. . F S DFN=$O(^TMP("PXRMPLN",$J,PNAME,DFN)) Q:DFN="" D
  1. .. W !,PNAME_DC
  1. .. F IND=1:1:NDT D
  1. ... I DATALIST(IND)="ADD" D PDELDATA(DFN,DC,.DDATA,"ADD") Q
  1. ... I DATALIST(IND)="APP" D PAPPDATA(DFN,DC,.DDATA,"APP") Q
  1. ... I DATALIST(IND)="DEM" D PDELDATA(DFN,DC,.DDATA,"DEM") Q
  1. ... I DATALIST(IND)="ELIG" D PDELDATA(DFN,DC,.DDATA,"ELIG") Q
  1. ... I DATALIST(IND)="FIND" D PFINDATA(DFN,DC,.DDATA,"FIND") Q
  1. ... I DATALIST(IND)="INP" D PDELDATA(DFN,DC,.DDATA,"INP") Q
  1. ... I DATALIST(IND)="PFAC" D PFACDATA(DFN,DC,.DDATA,"PFAC") Q
  1. ... I DATALIST(IND)="REM" D PREMDATA(DFN,DC,.DDATA,"REM") Q
  1. .. W "\\"
  1. Q
  1. ;
  1. ;==========================================
  1. DELTITLE(DC,DATALIST,DDATA) ;Combine all the headers to create the delimited title.
  1. W !,"PATIENT"_DC
  1. N IND
  1. F IND=1:1:DATALIST(0) W DDATA(DATALIST(IND),"HDR")
  1. W "\\"
  1. Q
  1. ;
  1. ;==========================================
  1. FINDPR(DFN,DDATA,SUB) ;Print finding information.
  1. N IND,JND,LINE,TEMP
  1. D ADDTXT(" ")
  1. S LINE="Finding Data"
  1. D ADDTXT(LINE)
  1. F IND=1:1:DDATA(SUB,"LEN") D
  1. . S JND=$P(DDATA(SUB),",",IND)
  1. . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"FIND",JND))
  1. . I TEMP="" Q
  1. . S LINE=" "_$P(DDATA(SUB,JND,JND),U,1)_": "_TEMP
  1. . D ADDTXT(LINE)
  1. Q
  1. ;
  1. ;==========================================
  1. OUTPUT ;Output the text.
  1. N IND,LC,LO,VSIZE
  1. S VSIZE=IOSL-2
  1. S (LC,LO)=0
  1. F IND=1:1:LINCNT D
  1. . S LC=LC+1,LO=LO+1
  1. . W !,^TMP("PXRMPDEM",$J,LC)
  1. . I LO=VSIZE D
  1. .. D PAGE
  1. .. I $D(DTOUT)!$D(DUOUT) S IND=LINCNT Q
  1. .. S LO=0
  1. Q
  1. ;
  1. ;==========================================
  1. PAGE ;
  1. I ($E(IOST,1,2)="C-")&(IO=IO(0)) D
  1. . N DIR
  1. . S DIR(0)="E"
  1. . W !
  1. . D ^DIR K DIR
  1. I $D(DUOUT)!$D(DTOUT) Q
  1. W:$D(IOF) @IOF
  1. I ($E(IOST,1,2)="C-")&(IO=IO(0)) W @IOF
  1. Q
  1. ;
  1. ;==========================================
  1. PAPPDATA(DFN,DC,DDATA,SUB) ;Print the delimited appointment data.
  1. N IND,JND,KND,LINE,LND,PIECE,TEMP
  1. I DDATA(SUB,"LEN")'>0 Q
  1. S LINE=""
  1. F IND=1:1:DDATA(SUB,"MAX") D
  1. . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"APP",IND))
  1. . F JND=1:1:DDATA(SUB,"LEN") D
  1. .. S KND=$P(DDATA(SUB),",",JND)
  1. .. S LND=""
  1. .. F S LND=$O(DDATA(SUB,KND,LND)) Q:LND="" D
  1. ... S PIECE=$P(DDATA(SUB,KND,KND),U,2)
  1. ... S LINE=LINE_$P(TEMP,U,PIECE)_DC
  1. W LINE
  1. Q
  1. ;
  1. ;==========================================
  1. PDELDATA(DFN,DC,DDATA,SUB) ;Print the delimited data.
  1. N IND,JND,KND,LINE,LND,MAX,TEMP,TTEMP
  1. S TEMP=$G(^TMP("PXRMPLD",$J,DFN,SUB))
  1. S LINE=""
  1. F IND=1:1:DDATA(SUB,"LEN") D
  1. . S JND=$P(DDATA(SUB),",",IND)
  1. . S KND=""
  1. . F S KND=$O(DDATA(SUB,JND,KND)) Q:KND="" D
  1. ..;KND is the piece number in TEMP
  1. ..;MAX is the number of occurrences to get.
  1. .. S MAX=+$P(DDATA(SUB,JND,KND),U,3)
  1. ..;If MAX=0 just append the delimiter character.
  1. .. I MAX=0 S LINE=LINE_$P(TEMP,U,KND)_DC Q
  1. ..;"~" is the within piece separator for multiple occurrences.
  1. .. I MAX>0 S TTEMP=$P(TEMP,U,KND) F LND=1:1:MAX S LINE=LINE_$P(TTEMP,"~",LND)_DC
  1. W LINE
  1. Q
  1. ;
  1. ;==========================================
  1. PFACHDR(DC,DDATA,SUB) ;Build the preferred facility header.
  1. I DDATA(SUB,0)=1 S DDATA(SUB,"HDR")="PATIENT'S PREFERRED FACILITY"_DC
  1. Q
  1. ;
  1. ;==========================================
  1. PFACDATA(DFN,DC,DDATA,SUB) ;Print the patient's preferred facility data,
  1. ;delimited.
  1. I DDATA(SUB,0)=0 Q
  1. W ^TMP("PXRMPLD",$J,DFN,"PFAC")_DC
  1. Q
  1. ;
  1. ;==========================================
  1. PFACPR(DFN,DDATA,SUB) ;Print the patient's preferred facility.
  1. I DDATA(SUB,0)=0 Q
  1. D ADDTXT("Patient's Preferred Facility")
  1. D ADDTXT(" "_$G(^TMP("PXRMPLD",$J,DFN,"PFAC")))
  1. Q
  1. ;
  1. ;==========================================
  1. PFINDATA(DFN,DC,DDATA,SUB) ;Print the finding data.
  1. N IND,JND,LINE,TEMP
  1. I DDATA(SUB,"LEN")'>0 Q
  1. S LINE=""
  1. F IND=1:1:DDATA(SUB,"LEN") D
  1. . S JND=$P(DDATA(SUB),",",IND)
  1. . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"FIND",JND))
  1. . S LINE=LINE_TEMP_DC
  1. W LINE
  1. Q
  1. ;
  1. ;==========================================
  1. PREMDATA(DFN,DC,DDATA,SUB) ;Print the reminder data.
  1. N IND,JND,LINE,TEMP
  1. I DDATA(SUB,"LEN")'>0 Q
  1. S LINE=""
  1. F IND=1:1:DDATA(SUB,"LEN") D
  1. . S JND=$P(DDATA(SUB),",",IND)
  1. . S LINE=LINE_DDATA(SUB,"RNAME",JND)_DC
  1. . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"REM",DDATA(SUB,"IEN",JND)))
  1. . S LINE=LINE_$P(TEMP,U,2)_DC_$P(TEMP,U,3)_"^"_$P(TEMP,U,4)_DC
  1. W LINE
  1. Q
  1. ;
  1. ;==========================================
  1. REGPR(PLIEN,DDATA,SUB) ;
  1. ;Print the regular report..
  1. N DATATYPE,DFN,PNAME,LINCNT
  1. K ^TMP("PXRMPDEM",$J)
  1. S LINCNT=0
  1. D TITLE(PLIEN,0)
  1. S PNAME=":"
  1. F S PNAME=$O(^TMP("PXRMPLN",$J,PNAME)) Q:PNAME="" D
  1. . S DFN=0
  1. . F S DFN=$O(^TMP("PXRMPLN",$J,PNAME,DFN)) Q:DFN="" D
  1. .. D ADDTXT(" ")
  1. .. D ADDTXT("---------- "_PNAME_" DFN="_DFN_" ----------")
  1. .. S DATATYPE=""
  1. .. F S DATATYPE=$O(^TMP("PXRMPLD",$J,DFN,DATATYPE)) Q:DATATYPE="" D
  1. ... I DATATYPE="ADD" D VADPTPR(DFN,"Address Data",DATATYPE,.DDATA,"ADD") Q
  1. ... I DATATYPE="APP" D APPPRINT(DFN,.DDATA,"APP") Q
  1. ... I DATATYPE="DEM" D VADPTPR(DFN,"Demographic Data",DATATYPE,.DDATA,"DEM") Q
  1. ... I DATATYPE="ELIG" D VADPTPR(DFN,"Eligibility Data",DATATYPE,.DDATA,"ELIG") Q
  1. ... I DATATYPE="FIND" D FINDPR(DFN,.DDATA,"FIND") Q
  1. ... I DATATYPE="INP" D VADPTPR(DFN,"Inpatient Data",DATATYPE,.DDATA,"INP") Q
  1. ... I DATATYPE="PFAC" D PFACPR(DFN,.DDATA,"PFAC") Q
  1. ... I DATATYPE="REM" D REMPR(DFN,.DDATA,"REM") Q
  1. D OUTPUT
  1. K ^TMP("PXRMPDEM",$J)
  1. Q
  1. ;
  1. ;==========================================
  1. REMHDR(DC,DDATA,SUB) ;Build the reminder data delimited header.
  1. N HDR,IND,JND
  1. S HDR=""
  1. F IND=1:1:DDATA(SUB,"LEN") D
  1. . S JND=$P(DDATA(SUB),",",IND)
  1. . S HDR=HDR_"REMINDER"_JND_DC_"STATUS"_JND_DC_"DUE DATE"_JND_DC_"LAST DONE"_JND_DC
  1. S DDATA(SUB,"HDR")=HDR
  1. Q
  1. ;
  1. ;==========================================
  1. REMPR(DFN,DDATA,SUB) ;Print reminder status information.
  1. N DUE,IND,JND,LAST,LINE,NSP,RIEN,STATUS,TEMP
  1. D ADDTXT(" ")
  1. S LINE="Reminder:"_$$INSCHR^PXRMEXLC(27," ")_"--STATUS-- --DUE DATE-- --LAST DONE--"
  1. D ADDTXT(LINE)
  1. F IND=1:1:DDATA(SUB,"LEN") D
  1. . S JND=$P(DDATA(SUB),",",IND)
  1. . S RIEN=DDATA(SUB,"IEN",JND)
  1. . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"REM",RIEN))
  1. . I TEMP="" Q
  1. . S STATUS=$P(TEMP,U,2)
  1. . S DUE=$P(TEMP,U,3),DUE=$$EDATE^PXRMDATE(DUE)
  1. . S LAST=$P(TEMP,U,4),LAST=$$EDATE^PXRMDATE(LAST)
  1. . S NSP=38-$L(DDATA(SUB,"RNAME",JND))
  1. . S LINE=DDATA(SUB,"RNAME",JND)_$$INSCHR^PXRMEXLC(NSP," ")_STATUS
  1. . S NSP=54-$L(LINE)-($L(DUE)/2)
  1. . S LINE=LINE_$$INSCHR^PXRMEXLC(NSP," ")_DUE
  1. . S NSP=69-$L(LINE)-($L(LAST)/2)
  1. . S LINE=LINE_$$INSCHR^PXRMEXLC(NSP," ")_LAST
  1. . D ADDTXT(LINE)
  1. Q
  1. ;
  1. ;==========================================
  1. TITLE(PLIEN,DELIM) ;Print the report title.
  1. N DCREATE,LISTNAME
  1. S LISTNAME=$P(^PXRMXP(810.5,PLIEN,0),U,1)
  1. S DCREATE=$P(^PXRMXP(810.5,PLIEN,0),U,4)
  1. I DELIM D
  1. . W @IOF
  1. . W !,"Patient Demographic Report"
  1. . W !," Patient List: "_LISTNAME
  1. . W !," Created on "_$$FMTE^XLFDT(DCREATE)
  1. I 'DELIM D
  1. . D ADDTXT("Patient Demographic Report")
  1. . D ADDTXT(" Patient List: "_LISTNAME)
  1. . D ADDTXT(" Created on "_$$FMTE^XLFDT(DCREATE))
  1. Q
  1. ;
  1. ;==========================================
  1. VADPTPR(DFN,DNAME,DTYPE,DDATA,SUB) ;Print data returned by a VADPT call.
  1. N IND,JND,KND,LINE,LND,MAX,TEMP,TTEMP
  1. D ADDTXT(" ")
  1. D ADDTXT(DNAME)
  1. S TEMP=$G(^TMP("PXRMPLD",$J,DFN,DTYPE))
  1. F IND=1:1:DDATA(SUB,"LEN") D
  1. . S JND=$P(DDATA(SUB),",",IND)
  1. . S KND=""
  1. . F S KND=$O(DDATA(SUB,JND,KND)) Q:KND="" D
  1. .. S TTEMP=$P(TEMP,U,KND)
  1. ..;MAX is the number of occurrences to print.
  1. .. S MAX=+$P(DDATA(SUB,JND,KND),U,3)
  1. .. I MAX=0 S MAX=1
  1. .. F LND=1:1:MAX D
  1. ... S LINE=" "_$P(DDATA(SUB,JND,KND),U,1)_": "_$P(TTEMP,"~",LND)
  1. ... D ADDTXT(LINE)
  1. Q
  1. ;