source: FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMPTDF.m

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