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

PXRMPTDF.m

Go to the documentation of this file. 
  1. PXRMPTDF ;SLC/PKR/PJH - Reminder Inquiry print template routines. ;08/25/2020
  1.  ;;2.0;CLINICAL REMINDERS;**4,6,12,46,65**;Feb 04, 2005;Build 438
  1.  ;
  1.  ;================================================
  1. PFIND ;Print the reminder definition finding multiple.
  1.  N DIWF,FIELD,FILENUM,FINDING,FIND0,FIND3,FINDNAM,FL,HFCAT,HFIEN
  1.  N IEN1,IND,INT,LEN,NL,OUTPUT,PAD,PADS,PARRAY
  1.  N RJC,RFIND,RTERM,SCNT,SIEN,STAT0,TEMP,X
  1.  ;If called by a FileMan print build the variable pointer list.
  1.  I '$D(PXRMFVPL) N PXRMFVPL D BLDRLIST^PXRMVPTR(811.902,.01,.PXRMFVPL)
  1.  ;No printing is done by PFIND it accumulates all output using ^DIWP.
  1.  ;The print template outputs the text with ^DIWW.
  1.  ;Because of the way DIWP works we need to format all the found and
  1.  ;not found text first and store it in ^TMP.
  1.  K ^TMP($J,"W")
  1.  S FILENUM="811.902"
  1.  S RJC=30,PAD=" ",PADS=""
  1.  F IND=1:1:(RJC+2) S PADS=PADS_PAD
  1.  S FINDING=0
  1.  F  S FINDING=$O(^PXD(811.9,D0,20,FINDING)) Q:+FINDING=0  D
  1.  . D WPFORMAT(FINDING,20,RJC,1)
  1.  . D WPFORMAT(FINDING,20,RJC,2)
  1.  K ^UTILITY($J,"W")
  1.  S FINDING=0
  1.  F  S FINDING=$O(^PXD(811.9,D0,25,FINDING)) Q:+FINDING=0  D
  1.  . D WPFORMAT(FINDING,25,RJC,1)
  1.  . D WPFORMAT(FINDING,25,RJC,2)
  1.  . D WPFORMAT(FINDING,25,RJC,20)
  1.  S DIWF="C80",DIWL=2
  1.  K ^UTILITY($J,"W")
  1.  S FINDING=0
  1.  F  S FINDING=$O(^PXD(811.9,D0,20,FINDING)) Q:+FINDING=0  D
  1.  . S FIND0=^PXD(811.9,D0,20,FINDING,0)
  1.  . S FIELD=$P(FIND0,U,1)
  1.  . S RTERM=FIELD
  1.  . S X=" "
  1.  . D ^DIWP
  1.  . S FINDNAM=$$ENTRYNAM^PXRMPTD2(FIELD)
  1.  . I FINDNAM="" S FINDNAM="?"
  1.  . S RFIND=$$GENIEN^PXRMPTD2(FINDING)
  1.  . S X="---- Begin: "_FINDNAM_RFIND
  1.  . D FORMATS^PXRMTEXT(2,75,X,.NL,.OUTPUT)
  1.  . F IND=1:1:NL D
  1.  .. S X=OUTPUT(IND)
  1.  .. I IND=NL S X=X_" ",LEN=75-$L(X) F INT=1:1:LEN S X=X_"-"
  1.  .. D ^DIWP
  1.  .;
  1.  . S X=$$RJ^XLFSTR("Finding Type:",RJC,PAD)
  1.  . S X=X_" "_$$FTYPE^PXRMPTD2(FIELD,0)
  1.  . D ^DIWP
  1.  . I RFIND["HF" D
  1.  .. S HFIEN=$P($P($P(RFIND,"HF",2),"(",2),")")
  1.  .. S HFCAT=$P($G(^AUTTHF(HFIEN,0)),U,3)
  1.  .. S HFCAT=$S(HFCAT="":"UNDEFINED",1:$P($G(^AUTTHF(HFCAT,0)),U,1))
  1.  .. S X=$$RJ^XLFSTR("Health Factor Category:",RJC,PAD)
  1.  .. S X=X_" "_HFCAT
  1.  .. D ^DIWP
  1.  .;
  1.  . S FIELD=$P(FIND0,U,4)
  1.  . I $L(FIELD)>0 D
  1.  .. S X=$$RJ^XLFSTR("Match Frequency/Age:",RJC,PAD)
  1.  .. S X=X_" "_$$GENFREQ^PXRMPTD2(FIND0)
  1.  .. D ^DIWP
  1.  .;
  1.  . D SFDISP(FIND0,5,6,"Rank Frequency:",RJC,PAD,FILENUM)
  1.  . D SFDISP(FIND0,6,7,"Use in Resolution Logic:",RJC,PAD,FILENUM)
  1.  . D SFDISP(FIND0,7,8,"Use in Patient Cohort Logic:",RJC,PAD,FILENUM)
  1.  . D DATE^PXRMPTD2(FIND0,8,9,"Beginning Date/Time:",RJC,PAD,FILENUM)
  1.  . D DATE^PXRMPTD2(FIND0,11,12,"Ending Date/Time:",RJC,PAD,FILENUM)
  1.  . D SFDISP(FIND0,14,17,"Occurrence Count:",RJC,PAD,FILENUM)
  1.  . D SFDISP(FIND0,9,10,"Use Inactive Problems:",RJC,PAD,FILENUM)
  1.  . D SFDISP(FIND0,10,11,"Within Category Rank:",RJC,PAD,FILENUM)
  1.  . D SFDISP(FIND0,16,28,"Include Visit Data:",RJC,PAD,FILENUM)
  1.  . D SFDISP(FIND0,12,13,"MH Scale:",RJC,PAD,FILENUM)
  1.  . D SFDISP(FIND0,13,16,"Rx Type:",RJC,PAD,FILENUM)
  1.  . D SFDISP(FIND0,15,27,"Use Start Date:",RJC,PAD,FILENUM)
  1.  . D SFDISP(FIND0,17,29,"Immunization Search Criteria:",RJC,PAD,FILENUM)
  1.  . I $D(^PXD(811.9,D0,20,FINDING,5,0))=1 D
  1.  .. S (SCNT,SIEN)=0
  1.  .. F  S SIEN=$O(^PXD(811.9,D0,20,FINDING,5,SIEN)) Q:SIEN=""  D
  1.  ... S STAT0=$G(^PXD(811.9,D0,20,FINDING,5,SIEN,0))
  1.  ... D STATUS(STAT0,"Status List:",RJC) S SCNT=SCNT+1
  1.  . S FIND0=$G(^PXD(811.9,D0,20,FINDING,3))
  1.  . D SFDISP(FIND0,1,14,"Condition:",RJC,PAD,FILENUM)
  1.  . D SFDISP(FIND0,2,15,"Condition Case Sensitive:",RJC,PAD,FILENUM)
  1.  . D SFDISP(FIND0,3,18,"Use Status/Cond in Search:",RJC,PAD,FILENUM)
  1.  . I $G(^PXD(811.9,D0,20,FINDING,15))'="" D 
  1.  .. S X=$$RJ^XLFSTR("Computed Finding Parameter:",RJC,PAD)
  1.  .. S X=X_" "_$G(^PXD(811.9,D0,20,FINDING,15))
  1.  .. D ^DIWP
  1.  . D WPOUT(FINDING,20,"Found Text:",RJC,PAD,PADS,1)
  1.  . D WPOUT(FINDING,20,"Not Found Text:",RJC,PAD,PADS,2)
  1.  . I RTERM["PXRMD(811.5" S IEN1=$P(RTERM,";") D RTERM
  1.  . S X="---- End: "_FINDNAM
  1.  . D FORMATS^PXRMTEXT(2,75,X,.NL,.OUTPUT)
  1.  . F IND=1:1:NL D
  1.  .. S X=OUTPUT(IND)
  1.  .. I IND=NL S X=X_" ",LEN=75-$L(X) F INT=1:1:LEN S X=X_"-"
  1.  .. D ^DIWP
  1.  ;
  1.  ;Function Findings
  1.  I +$P($G(^PXD(811.9,D0,25,0)),U,4)>0 D
  1.  . S X=" "
  1.  . D ^DIWP
  1.  . S X="Function Findings:"
  1.  . D ^DIWP
  1.  .;Build the list of findings for this reminder.
  1.  . D BLDFLST^PXRMPTL(D0,.FL)
  1.  . S FILENUM="811.925",FINDING=0
  1.  . F  S FINDING=$O(^PXD(811.9,D0,25,FINDING)) Q:+FINDING=0  D
  1.  .. S FIND0=$G(^PXD(811.9,D0,25,FINDING,0))
  1.  .. S FIND3=$G(^PXD(811.9,D0,25,FINDING,3))
  1.  .. I FIND3="" Q
  1.  .. S FIELD=$P(FIND0,U,1)
  1.  .. S FINDNAM="FF("_FIELD_")"
  1.  .. S X=" "
  1.  .. D ^DIWP
  1.  .. S X=$$RJ^XLFSTR("---- Begin:",12,PAD)
  1.  .. S X=X_" "_FINDNAM
  1.  .. S LEN=(75-$L(X))
  1.  .. F INT=1:1:LEN S X=X_"-"
  1.  .. D ^DIWP
  1.  ..;
  1.  .. D SFDISP(FIND3,1,3,"Function String:",RJC,PAD,FILENUM)
  1.  .. S X="     Expanded Function String:" D ^DIWP
  1.  .. D DISLOGF^PXRMPTL(D0,FINDING,.FL,.PARRAY)
  1.  .. S INT=0
  1.  .. F  S INT=$O(PARRAY(INT)) Q:'INT  D
  1.  ... S X=$J("",6)_PARRAY(INT) D ^DIWP
  1.  .. D WPOUT(FINDING,25,"Description:",RJC,PAD,PADS,20)
  1.  ..;
  1.  .. S FIELD=$P(FIND0,U,4)
  1.  .. I $L(FIELD)>0 D
  1.  ... S X=$$RJ^XLFSTR("Match Frequency/Age:",RJC,PAD)
  1.  ... S X=X_" "_$$GENFREQ^PXRMPTD2(FIND0)
  1.  ... D ^DIWP
  1.  ..;
  1.  .. D SFDISP(FIND0,5,10,"Rank Frequency:",RJC,PAD,FILENUM)
  1.  .. D SFDISP(FIND0,6,11,"Use in Resolution Logic:",RJC,PAD,FILENUM)
  1.  .. D SFDISP(FIND0,7,12,"Use in Patient Cohort Logic:",RJC,PAD,FILENUM)
  1.  ..;
  1.  .. D WPOUT(FINDING,25,"Found Text:",RJC,PAD,PADS,1)
  1.  .. D WPOUT(FINDING,25,"Not Found Text:",RJC,PAD,PADS,2)
  1.  .. S X=$$RJ^XLFSTR("---- End:",10,PADS)
  1.  .. S X=X_" "_FINDNAM_" "
  1.  .. S LEN=(75-$L(X))
  1.  .. F INT=1:1:(LEN) S X=X_"-"
  1.  .. D ^DIWP
  1.  .. S X=" "
  1.  .. D ^DIWP
  1.  ;
  1.  K ^TMP($J,"W")
  1.  ;^UTILITY($J,"W") will be killed by ^DIWW in the print template.
  1.  Q
  1.  ;
  1.  ;================================================
  1. RTERM ;Reminder Term
  1.  N CNT,RJT,SCNT,SIEN,STAT0,TERM,TERM3,TERMNUM,TERMS
  1.  S CNT=0,RJT=RJC+5,TERMNUM="811.52",TERMS=0
  1.   F  S TERMS=$O(^PXRMD(811.5,IEN1,20,TERMS)) Q:+TERMS=0  D
  1.  .S TERM=$G(^PXRMD(811.5,IEN1,20,TERMS,0))
  1.  .S TERM3=$G(^PXRMD(811.5,IEN1,20,TERMS,3))
  1.  .D SFDISP(TERM,1,.01,"Mapped Finding Item:",RJT,PAD,TERMNUM,CNT)
  1.  .D DATE^PXRMPTD2(TERM,8,9,"Beginning Date/Time:",RJT,PAD,TERMNUM)
  1.  .D SFDISP(TERM,9,10,"Use Inactive Problems:",RJT,PAD,TERMNUM)
  1.  .D DATE^PXRMPTD2(TERM,11,12,"Ending Date/Time:",RJT,PAD,TERMNUM)
  1.  .D SFDISP(TERM,10,11,"Within Category Rank:",RJT,PAD,TERMNUM)
  1.  .D SFDISP(TERM,12,13,"MH Scale:",RJT,PAD,TERMNUM)
  1.  .D SFDISP(TERM,13,16,"RX Type:",RJT,PAD,TERMNUM)
  1.  .D SFDISP(TERM,14,17,"Occurrence Count:",RJT,PAD,TERMNUM)
  1.  .I $D(^PXRMD(811.5,IEN1,20,TERMS,5,0))=1 D
  1.  ..S (SCNT,SIEN)=0
  1.  ..F  S SIEN=$O(^PXRMD(811.5,IEN1,20,TERMS,5,SIEN)) Q:SIEN=""  D
  1.  ...S STAT0=$G(^PXRMD(811.5,IEN1,20,TERMS,5,SIEN,0))
  1.  ...D STATUS(STAT0,"Status List:",RJT) S SCNT=SCNT+1
  1.  .D SFDISP(TERM3,1,14,"Condition:",RJT,PAD,TERMNUM,1)
  1.  .D SFDISP(TERM3,2,15,"Condition Case Sensitive:",RJT,PAD,TERMNUM)
  1.  .D SFDISP(TERM3,3,18,"Use Status/Cond in Search:",RJT,PAD,TERMNUM)
  1.  .I $G(^PXRMD(811.5,IEN1,20,TERMS,15))'="" D 
  1.  ..S X=$$RJ^XLFSTR("Computed Finding Parameter:",RJT,PAD)
  1.  ..S X=X_" "_$G(^PXRMD(811.5,IEN1,20,TERMS,15))
  1.  ..D ^DIWP
  1.  .S X=""
  1.  .D ^DIWP
  1.  .S CNT=CNT+1
  1.  I CNT=0 D  Q
  1.  .S X=$$RJ^XLFSTR("RT Mapped Finding:",RJC,PAD)
  1.  .S X=X_" No Reminder Finding Found"
  1.  .D ^DIWP
  1.  Q
  1.  ;
  1.  ;================================================
  1. SFDISP(FIND0,PIECE,FLDNUM,TITLE,RJC,PAD,FILENUM,FLG) ;Standard finding
  1.  ;multiple field display.
  1.  N FIELD,FMTSTR,HFCAT,HFIEN,IND,OUTPUT,NAME,NL,TYPE,X
  1.  S FMTSTR=RJC_"R1^35L"
  1.  S NAME=""
  1.  S FIELD=$P(FIND0,U,PIECE)
  1.  I (FILENUM="811.52"),(FLDNUM=".01"),(PIECE=1) D
  1.  .I FLG=0 D
  1.  ..S X="" D ^DIWP
  1.  ..S RTERM=$P($P(RFIND,"=",2),")")_")"
  1.  .S TYPE=$$FTYPE^PXRMPTD2(FIELD,1),NAME=$$ENTRYNAM^PXRMPTD2(FIELD)
  1.  .S X="Mapped Findings:^"_TYPE_"."_NAME
  1.  .D COLFMT^PXRMTEXT(FMTSTR,X,PAD,.NL,.OUTPUT)
  1.  .F IND=1:1:NL S X=OUTPUT(IND) D ^DIWP
  1.  .I TYPE="HF" D
  1.  ..S HFIEN=$P(TERM,";")
  1.  ..S HFCAT=$P($G(^AUTTHF(HFIEN,0)),U,3)
  1.  ..S HFCAT=$P($G(^AUTTHF(HFCAT,0)),U)
  1.  ..S X=$$RJ^XLFSTR("Health Factor Category:",RJC,PAD)
  1.  ..S X=X_" "_HFCAT
  1.  ..D ^DIWP
  1.  I NAME'="" Q
  1.  I $L(FIELD)>0 D
  1.  .S X=$$RJ^XLFSTR(TITLE,RJC,PAD)
  1.  .S X=X_" "_$$EXTERNAL^DILFD(FILENUM,FLDNUM,"",FIELD,"")
  1.  .I FLDNUM=13 S X=X_" - "_$$SPECIAL(FIND0,FIELD)
  1.  .D ^DIWP
  1.  Q
  1.  ;
  1.  ;================================================
  1. SPECIAL(FIND0,FIELD) ;Special output for certain fields.
  1.  N FINDING,GLOBAL,IEN
  1.  S FINDING=$P(FIND0,U,1)
  1.  S IEN=$P(FINDING,";",1)
  1.  S GLOBAL=$P(FINDING,";",2)
  1.  I GLOBAL="YTT(601.71," Q $$SCNAME^PXRMMH(IEN,FIELD)
  1.  Q ""
  1.  ;
  1.  ;================================================
  1. STATUS(STAT0,TITLE,SPACE) ;
  1.  I $L(STAT0)>0 D
  1.  .I SCNT=0 S X=$$RJ^XLFSTR(TITLE,SPACE,PAD)
  1.  .I SCNT>0 S X=$$RJ^XLFSTR("",SPACE,PAD)
  1.  .S X=X_" "_STAT0
  1.  .D ^DIWP
  1.  Q
  1.  ;
  1.  ;================================================
  1. WPFORMAT(FINDING,NODE,RJC,INDEX) ;Format found/not word processing text.
  1.  I '$D(^PXD(811.9,D0,NODE,FINDING,INDEX,1,0)) Q
  1.  ;Save the title using the current format for DIWP.
  1.  N DIWF,DIWL,DIWR,IND,NLINES,SC,X
  1.  K ^UTILITY($J,"W")
  1.  S DIWF="|",DIWL=RJC+2,DIWR=78
  1.  S IND=0
  1.  F  S IND=$O(^PXD(811.9,D0,NODE,FINDING,INDEX,IND)) Q:+IND=0  D
  1.  .S X=$G(^PXD(811.9,D0,NODE,FINDING,INDEX,IND,0))
  1.  .D ^DIWP
  1.  ;Find where this stuff went.
  1.  S SC=$O(^UTILITY($J,"W",""))
  1.  ;Save into ^TMP.
  1.  S NLINES=^UTILITY($J,"W",SC)
  1.  S ^TMP($J,"W",FINDING,NODE,INDEX)=NLINES
  1.  F IND=1:1:NLINES D
  1.  .S ^TMP($J,"W",FINDING,NODE,INDEX,IND)=^UTILITY($J,"W",SC,IND,0)
  1.  K ^UTILITY($J,"W")
  1.  Q
  1.  ;
  1.  ;================================================
  1. WPOUT(FINDING,NODE,TITLE,RJC,PAD,PADS,INDEX) ;Output found/not found,
  1.  ;word processing text.
  1.  I $D(^TMP($J,"W",FINDING,NODE,INDEX)) D
  1.  .N IND,X
  1.  .S X=$$RJ^XLFSTR(TITLE,RJC,PAD)_" "_^TMP($J,"W",FINDING,NODE,INDEX,1)
  1.  .D ^DIWP
  1.  .F IND=2:1:^TMP($J,"W",FINDING,NODE,INDEX) D
  1.  ..S X=PADS_^TMP($J,"W",FINDING,NODE,INDEX,IND)
  1.  ..D ^DIWP
  1.  Q
  1.  ;