PXRMPTTR ;SLC/PKR - Routines for term print templates ;01/14/2020
;;2.0;CLINICAL REMINDERS;**4,6,12,65**;Feb 04, 2005;Build 438
;
;====================================================
DATE(FIND0,PIECE,FLDNUM,TITLE,RJC,PAD,FILENUM,FLG) ;Standard DATE
N DATE,TEXT
S DATE=$P($G(FIND0),U,PIECE)
I DATE'="" D
. S DATE=$$FMTE^XLFDT(DATE,"D")
. S TEXT=$$RJ^XLFSTR(TITLE,RJC,PAD)_" "_DATE
. W !,TEXT
Q
;
;====================================================
GENIEN(FINDING) ;Return internal entry number for findings.
N F0,IEN,PREFIX,ROOT,VPTR
S ROOT="^PXRMD(811.5,D0,20,FINDING,0)"
S F0=@ROOT
S VPTR=$P(F0,U,1)
S IEN=$P(VPTR,";",1)
S ROOT=$P(VPTR,";",2)
I '$D(PXRMFVPL) N PXRMFVPL D BLDRLIST^PXRMVPTR(811.52,.01,.PXRMFVPL)
S VPTR=PXRMFVPL(ROOT)
S PREFIX=$P(VPTR,U,4)
Q " (FI("_+FINDING_")="_PREFIX_"("_IEN_"))"
;
;====================================================
ENTRYNAM(VPTR) ;Given the variable pointer return the entry name. The
;variable pointer list contains the information necessary to do the
;look up.
N IEN,FILENUM,NAME,ROOT
S IEN=$P(VPTR,";",1)
S ROOT=$P(VPTR,";",2)
S FILENUM=$P(PXRMFVPL(ROOT),U,1)
S NAME=$$GET1^DIQ(FILENUM,IEN,.01,"","","")
Q NAME
;
;====================================================
PFIND ;Print the reminder term finding multiple.
N CFP,FIELD,FINDING,FIND0,FMTSTR,HFCAT,HFIEN,IND,NL,OUTPUT
N PAD,PXRMFVPL,RJC,SCNT,SIEN,STAT0,TEXT
;If called by a FileMan print, build the variable pointer list.
I '$D(PXRMFVPL) N PXRMFVPL D BLDRLIST^PXRMVPTR(811.52,.01,.PXRMFVPL)
S FMTSTR="18R^13L1^45L"
S PAD=" ",RJC=31
S FINDING=0
F S FINDING=$O(^PXRMD(811.5,D0,20,FINDING)) Q:+FINDING=0 D
. S FIND0=^PXRMD(811.5,D0,20,FINDING,0)
. S FIELD=$P(FIND0,U,1)
. S TEXT="^Finding Item:^"_$$ENTRYNAM(FIELD)_$$GENIEN(FINDING)
. D COLFMT^PXRMTEXT(FMTSTR,TEXT," ",.NL,.OUTPUT)
. W ! F IND=1:1:NL W !,OUTPUT(IND)
.;
. S TEXT=$$RJ^XLFSTR("Finding Type:",RJC,PAD)_" "_$$TFTYPE(FIELD)
. W !,TEXT
. I FIND0["AUTTHF" D
.. S HFIEN=$P($P(FIND0,U),";")
.. S HFCAT=$P($G(^AUTTHF(HFIEN,0)),U,3)
.. S HFCAT=$S(HFCAT="":"UNDEFINED",1:$P($G(^AUTTHF(HFCAT,0)),U,1))
.. S TEXT=$$RJ^XLFSTR("Health Factor Category:",RJC,PAD)_" "_HFCAT
.. W !,TEXT
.;
. S FIELD=$P(FIND0,U,4)
. I $L(FIELD)>0 D
.. S TEXT=$$RJ^XLFSTR("Match Frequency/Age:",RJC,PAD)_" "_$$GENFREQ^PXRMPTD2(FIND0)
.. W !,TEXT
.;
. D DATE(FIND0,8,9,"Beginning Date/Time:",RJC,PAD)
. D DATE(FIND0,11,12,"Ending Date/Time Date:",RJC,PAD)
. D SFDISP(FIND0,14,17,"Occurrence Count:",RJC,PAD)
. D SFDISP(FIND0,9,10,"Use Inactive Problems:",RJC,PAD)
. D SFDISP(FIND0,10,11,"Within Category Rank:",RJC,PAD)
. D SFDISP(FIND0,12,13,"MH Scale:",RJC,PAD)
. D SFDISP(FIND0,16,28,"Include Visit Data:",RJC,PAD)
. D SFDISP(FIND0,13,16,"Rx Type:",RJC,PAD)
. D SFDISP(FIND0,15,27,"Use Start Date:",RJC,PAD)
. D SFDISP(FIND0,17,29,"Immunization Search Criteria:",RJC,PAD)
. I $D(^PXRMD(811.5,D0,20,FINDING,5,0))=1 D
.. S (SCNT,SIEN)=0
.. F S SIEN=$O(^PXRMD(811.5,D0,20,FINDING,5,SIEN)) Q:SIEN="" D
... S STAT0=$G(^PXRMD(811.5,D0,20,FINDING,5,SIEN,0))
... D STATUS(STAT0,"Status List:") S SCNT=SCNT+1
.;
. S FIND0=$G(^PXRMD(811.5,D0,20,FINDING,3))
. D SFDISP(FIND0,1,14,"Condition:",RJC,PAD)
. D SFDISP(FIND0,2,15,"Condition Case Sensitive:",RJC,PAD)
. D SFDISP(FIND0,3,18,"Use Status/Cond in Search:",RJC,PAD)
. I $G(^PXRMD(811.5,D0,20,FINDING,15))'="" D
.. S CFP=$$RJ^XLFSTR("Computed Finding Parameter:",RJC,PAD)
.. S CFP=CFP_" "_$G(^PXRMD(811.5,D0,20,FINDING,15))
.. W !,CFP
Q
;
;====================================================
SFDISP(FIND0,PIECE,FLDNUM,TITLE,RJC,PAD) ;Standard finding multiple
;field display.
N FIELD,TEXT
S FIELD=$P(FIND0,U,PIECE)
I $L(FIELD)>0 D
. S TEXT=$$RJ^XLFSTR(TITLE,RJC,PAD)
. S TEXT=TEXT_" "_$$EXTERNAL^DILFD(811.52,FLDNUM,"",FIELD,"")
. I FLDNUM=13 S TEXT=TEXT_"-"_$$SPECIAL^PXRMPTDF(FIND0,FIELD)
. W !,TEXT
Q
;
;====================================================
STATUS(STAT0,TITLE) ; Status display
I $L(STAT0)>0 D
. N STATUS
. I SCNT=0 S STATUS=$$RJ^XLFSTR(TITLE,RJC,PAD)
. I SCNT>0 S STATUS=$$RJ^XLFSTR("",RJC,PAD)
. S STATUS=STATUS_" "_STAT0
. W !,STATUS
Q
;
;====================================================
TFTYPE(VPTR) ;Return Term finding type
N ROOT,TFTYPE
S ROOT=$P(VPTR,";",2)
I '$D(PXRMFVPL) N PXRMFVPL D BLDRLIST^PXRMVPTR(811.52,.01,.PXRMFVPL)
S TFTYPE=$P(PXRMFVPL(ROOT),U,2)
Q TFTYPE
;
;====================================================
TRMIEN(FINDING) ;Return internal entry number for TERM findings.
N F0,IEN,PREFIX,ROOT,VPTR
S ROOT="^PXRMD(811.5,D0,20,FINDING,0)"
S F0=@ROOT
S VPTR=$P(F0,U,1)
S IEN=$P(VPTR,";",1)
S ROOT=$P(VPTR,";",2)
I '$D(PXRMFVPL) N PXRMFVPL D BLDRLIST^PXRMVPTR(811.52,.01,.PXRMFVPL)
S VPTR=PXRMFVPL(ROOT)
S PREFIX=$P(VPTR,U,4)
Q " (FI("_+FINDING_")="_PREFIX_"("_IEN_"))"
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMPTTR 4963 printed Dec 13, 2024@01:48:43 Page 2
PXRMPTTR ;SLC/PKR - Routines for term print templates ;01/14/2020
+1 ;;2.0;CLINICAL REMINDERS;**4,6,12,65**;Feb 04, 2005;Build 438
+2 ;
+3 ;====================================================
DATE(FIND0,PIECE,FLDNUM,TITLE,RJC,PAD,FILENUM,FLG) ;Standard DATE
+1 NEW DATE,TEXT
+2 SET DATE=$PIECE($GET(FIND0),U,PIECE)
+3 IF DATE'=""
Begin DoDot:1
+4 SET DATE=$$FMTE^XLFDT(DATE,"D")
+5 SET TEXT=$$RJ^XLFSTR(TITLE,RJC,PAD)_" "_DATE
+6 WRITE !,TEXT
End DoDot:1
+7 QUIT
+8 ;
+9 ;====================================================
GENIEN(FINDING) ;Return internal entry number for findings.
+1 NEW F0,IEN,PREFIX,ROOT,VPTR
+2 SET ROOT="^PXRMD(811.5,D0,20,FINDING,0)"
+3 SET F0=@ROOT
+4 SET VPTR=$PIECE(F0,U,1)
+5 SET IEN=$PIECE(VPTR,";",1)
+6 SET ROOT=$PIECE(VPTR,";",2)
+7 IF '$DATA(PXRMFVPL)
NEW PXRMFVPL
DO BLDRLIST^PXRMVPTR(811.52,.01,.PXRMFVPL)
+8 SET VPTR=PXRMFVPL(ROOT)
+9 SET PREFIX=$PIECE(VPTR,U,4)
+10 QUIT " (FI("_+FINDING_")="_PREFIX_"("_IEN_"))"
+11 ;
+12 ;====================================================
ENTRYNAM(VPTR) ;Given the variable pointer return the entry name. The
+1 ;variable pointer list contains the information necessary to do the
+2 ;look up.
+3 NEW IEN,FILENUM,NAME,ROOT
+4 SET IEN=$PIECE(VPTR,";",1)
+5 SET ROOT=$PIECE(VPTR,";",2)
+6 SET FILENUM=$PIECE(PXRMFVPL(ROOT),U,1)
+7 SET NAME=$$GET1^DIQ(FILENUM,IEN,.01,"","","")
+8 QUIT NAME
+9 ;
+10 ;====================================================
PFIND ;Print the reminder term finding multiple.
+1 NEW CFP,FIELD,FINDING,FIND0,FMTSTR,HFCAT,HFIEN,IND,NL,OUTPUT
+2 NEW PAD,PXRMFVPL,RJC,SCNT,SIEN,STAT0,TEXT
+3 ;If called by a FileMan print, build the variable pointer list.
+4 IF '$DATA(PXRMFVPL)
NEW PXRMFVPL
DO BLDRLIST^PXRMVPTR(811.52,.01,.PXRMFVPL)
+5 SET FMTSTR="18R^13L1^45L"
+6 SET PAD=" "
SET RJC=31
+7 SET FINDING=0
+8 FOR
SET FINDING=$ORDER(^PXRMD(811.5,D0,20,FINDING))
if +FINDING=0
QUIT
Begin DoDot:1
+9 SET FIND0=^PXRMD(811.5,D0,20,FINDING,0)
+10 SET FIELD=$PIECE(FIND0,U,1)
+11 SET TEXT="^Finding Item:^"_$$ENTRYNAM(FIELD)_$$GENIEN(FINDING)
+12 DO COLFMT^PXRMTEXT(FMTSTR,TEXT," ",.NL,.OUTPUT)
+13 WRITE !
FOR IND=1:1:NL
WRITE !,OUTPUT(IND)
+14 ;
+15 SET TEXT=$$RJ^XLFSTR("Finding Type:",RJC,PAD)_" "_$$TFTYPE(FIELD)
+16 WRITE !,TEXT
+17 IF FIND0["AUTTHF"
Begin DoDot:2
+18 SET HFIEN=$PIECE($PIECE(FIND0,U),";")
+19 SET HFCAT=$PIECE($GET(^AUTTHF(HFIEN,0)),U,3)
+20 SET HFCAT=$SELECT(HFCAT="":"UNDEFINED",1:$PIECE($GET(^AUTTHF(HFCAT,0)),U,1))
+21 SET TEXT=$$RJ^XLFSTR("Health Factor Category:",RJC,PAD)_" "_HFCAT
+22 WRITE !,TEXT
End DoDot:2
+23 ;
+24 SET FIELD=$PIECE(FIND0,U,4)
+25 IF $LENGTH(FIELD)>0
Begin DoDot:2
+26 SET TEXT=$$RJ^XLFSTR("Match Frequency/Age:",RJC,PAD)_" "_$$GENFREQ^PXRMPTD2(FIND0)
+27 WRITE !,TEXT
End DoDot:2
+28 ;
+29 DO DATE(FIND0,8,9,"Beginning Date/Time:",RJC,PAD)
+30 DO DATE(FIND0,11,12,"Ending Date/Time Date:",RJC,PAD)
+31 DO SFDISP(FIND0,14,17,"Occurrence Count:",RJC,PAD)
+32 DO SFDISP(FIND0,9,10,"Use Inactive Problems:",RJC,PAD)
+33 DO SFDISP(FIND0,10,11,"Within Category Rank:",RJC,PAD)
+34 DO SFDISP(FIND0,12,13,"MH Scale:",RJC,PAD)
+35 DO SFDISP(FIND0,16,28,"Include Visit Data:",RJC,PAD)
+36 DO SFDISP(FIND0,13,16,"Rx Type:",RJC,PAD)
+37 DO SFDISP(FIND0,15,27,"Use Start Date:",RJC,PAD)
+38 DO SFDISP(FIND0,17,29,"Immunization Search Criteria:",RJC,PAD)
+39 IF $DATA(^PXRMD(811.5,D0,20,FINDING,5,0))=1
Begin DoDot:2
+40 SET (SCNT,SIEN)=0
+41 FOR
SET SIEN=$ORDER(^PXRMD(811.5,D0,20,FINDING,5,SIEN))
if SIEN=""
QUIT
Begin DoDot:3
+42 SET STAT0=$GET(^PXRMD(811.5,D0,20,FINDING,5,SIEN,0))
+43 DO STATUS(STAT0,"Status List:")
SET SCNT=SCNT+1
End DoDot:3
End DoDot:2
+44 ;
+45 SET FIND0=$GET(^PXRMD(811.5,D0,20,FINDING,3))
+46 DO SFDISP(FIND0,1,14,"Condition:",RJC,PAD)
+47 DO SFDISP(FIND0,2,15,"Condition Case Sensitive:",RJC,PAD)
+48 DO SFDISP(FIND0,3,18,"Use Status/Cond in Search:",RJC,PAD)
+49 IF $GET(^PXRMD(811.5,D0,20,FINDING,15))'=""
Begin DoDot:2
+50 SET CFP=$$RJ^XLFSTR("Computed Finding Parameter:",RJC,PAD)
+51 SET CFP=CFP_" "_$GET(^PXRMD(811.5,D0,20,FINDING,15))
+52 WRITE !,CFP
End DoDot:2
End DoDot:1
+53 QUIT
+54 ;
+55 ;====================================================
SFDISP(FIND0,PIECE,FLDNUM,TITLE,RJC,PAD) ;Standard finding multiple
+1 ;field display.
+2 NEW FIELD,TEXT
+3 SET FIELD=$PIECE(FIND0,U,PIECE)
+4 IF $LENGTH(FIELD)>0
Begin DoDot:1
+5 SET TEXT=$$RJ^XLFSTR(TITLE,RJC,PAD)
+6 SET TEXT=TEXT_" "_$$EXTERNAL^DILFD(811.52,FLDNUM,"",FIELD,"")
+7 IF FLDNUM=13
SET TEXT=TEXT_"-"_$$SPECIAL^PXRMPTDF(FIND0,FIELD)
+8 WRITE !,TEXT
End DoDot:1
+9 QUIT
+10 ;
+11 ;====================================================
STATUS(STAT0,TITLE) ; Status display
+1 IF $LENGTH(STAT0)>0
Begin DoDot:1
+2 NEW STATUS
+3 IF SCNT=0
SET STATUS=$$RJ^XLFSTR(TITLE,RJC,PAD)
+4 IF SCNT>0
SET STATUS=$$RJ^XLFSTR("",RJC,PAD)
+5 SET STATUS=STATUS_" "_STAT0
+6 WRITE !,STATUS
End DoDot:1
+7 QUIT
+8 ;
+9 ;====================================================
TFTYPE(VPTR) ;Return Term finding type
+1 NEW ROOT,TFTYPE
+2 SET ROOT=$PIECE(VPTR,";",2)
+3 IF '$DATA(PXRMFVPL)
NEW PXRMFVPL
DO BLDRLIST^PXRMVPTR(811.52,.01,.PXRMFVPL)
+4 SET TFTYPE=$PIECE(PXRMFVPL(ROOT),U,2)
+5 QUIT TFTYPE
+6 ;
+7 ;====================================================
TRMIEN(FINDING) ;Return internal entry number for TERM findings.
+1 NEW F0,IEN,PREFIX,ROOT,VPTR
+2 SET ROOT="^PXRMD(811.5,D0,20,FINDING,0)"
+3 SET F0=@ROOT
+4 SET VPTR=$PIECE(F0,U,1)
+5 SET IEN=$PIECE(VPTR,";",1)
+6 SET ROOT=$PIECE(VPTR,";",2)
+7 IF '$DATA(PXRMFVPL)
NEW PXRMFVPL
DO BLDRLIST^PXRMVPTR(811.52,.01,.PXRMFVPL)
+8 SET VPTR=PXRMFVPL(ROOT)
+9 SET PREFIX=$PIECE(VPTR,U,4)
+10 QUIT " (FI("_+FINDING_")="_PREFIX_"("_IEN_"))"
+11 ;
