Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMPTTR.m

    r613 r623  
    1 PXRMPTTR        ;SLC/PKR - Routines for term print templates ;06/01/2007
    2         ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
    3         ;
    4         ;====================================================
    5 DATE(FIND0,PIECE,FLDNUM,TITLE,RJC,PAD,FILENUM,FLG)      ;Standard DATE
    6         N DATE,TEXT
    7         S DATE=$P($G(FIND0),U,PIECE)
    8         I DATE'="" D
    9         . S DATE=$$FMTE^XLFDT(DATE,"D")
    10         . S TEXT=$$RJ^XLFSTR(TITLE,RJC,PAD)
    11         . S TEXT=TEXT_" "_DATE
    12         . W !,TEXT
    13         Q
    14         ;
    15         ;====================================================
    16 GENIEN(FINDING) ;Return internal entry number for findings.
    17         N F0,IEN,PREFIX,ROOT,VPTR
    18         S ROOT="^PXRMD(811.5,D0,20,FINDING,0)"
    19         S F0=@ROOT
    20         S VPTR=$P(F0,U,1)
    21         S IEN=$P(VPTR,";",1)
    22         S ROOT=$P(VPTR,";",2)
    23         I '$D(PXRMFVPL) N PXRMFVPL D BLDRLIST^PXRMVPTR(811.52,.01,.PXRMFVPL)
    24         S VPTR=PXRMFVPL(ROOT)
    25         S PREFIX=$P(VPTR,U,4)
    26         Q " (FI("_+FINDING_")="_PREFIX_"("_IEN_"))"
    27         ;
    28         ;====================================================
    29 ENTRYNAM(VPTR)  ;Given the variable pointer return the entry name. The
    30         ;variable pointer list contains the information necessary to do the
    31         ;look up.
    32         N IEN,FILENUM,NAME,ROOT
    33         S IEN=$P(VPTR,";",1)
    34         S ROOT=$P(VPTR,";",2)
    35         S FILENUM=$P(PXRMFVPL(ROOT),U,1)
    36         S NAME=$$GET1^DIQ(FILENUM,IEN,.01,"","","")
    37         Q NAME
    38         ;
    39         ;====================================================
    40 PFIND   ;Print the reminder term finding multiple.
    41         N CFP,FIELD,FINDING,FIND0,HFCAT,HFIEN,PAD,PXRMFVPL
    42         N RJC,SCNT,SIEN,STAT0,TEXT
    43         ;If called by a FileMan print build the variable pointer list.
    44         I '$D(PXRMFVPL) N PXRMFVPL D BLDRLIST^PXRMVPTR(811.52,.01,.PXRMFVPL)
    45         S PAD=" ",RJC=31
    46         S FINDING=0
    47         F  S FINDING=$O(^PXRMD(811.5,D0,20,FINDING)) Q:+FINDING=0  D
    48         . S FIND0=^PXRMD(811.5,D0,20,FINDING,0)
    49         . S FIELD=$P(FIND0,U,1)
    50         . S TEXT=$$RJ^XLFSTR("Finding Item:",RJC,PAD)
    51         . S TEXT=TEXT_"  "_$$ENTRYNAM(FIELD)
    52         . S TEXT=TEXT_" "_$$TRMIEN(FINDING)
    53         . W !!,TEXT
    54         .;
    55         . S TEXT=$$RJ^XLFSTR("Finding Type:",RJC,PAD)
    56         . S TEXT=TEXT_"  "_$$TFTYPE(FIELD)
    57         . W !,TEXT
    58         . I FIND0["AUTTHF" D
    59         .. S HFIEN=$P($P(FIND0,U),";")
    60         .. S HFCAT=$P($G(^AUTTHF(HFIEN,0)),U,3)
    61         .. S HFCAT=$P($G(^AUTTHF(HFCAT,0)),U)
    62         .. S TEXT=$$RJ^XLFSTR("Health Factor Category:",RJC,PAD)
    63         .. S TEXT=TEXT_"  "_HFCAT
    64         .. W !,TEXT
    65         .;
    66         . S FIELD=$P(FIND0,U,4)
    67         . I $L(FIELD)>0 D
    68         .. S TEXT=$$RJ^XLFSTR("Match Frequency/Age:",RJC,PAD)
    69         .. S TEXT=TEXT_"  "_$$GENFREQ^PXRMPTD2(FIND0)
    70         .. W !,TEXT
    71         .;
    72         . D DATE(FIND0,8,9,"Beginning Date/Time:",RJC,PAD)
    73         . D DATE(FIND0,11,12,"Ending Date/Time Date:",RJC,PAD)
    74         . D SFDISP(FIND0,14,17,"Occurrence Count:",RJC,PAD)
    75         . D SFDISP(FIND0,9,10,"Use Inactive Problems:",RJC,PAD)
    76         . D SFDISP(FIND0,10,11,"Within Category Rank:",RJC,PAD)
    77         . D SFDISP(FIND0,12,13,"MH Scale:",RJC,PAD)
    78         . D SFDISP(FIND0,16,28,"Include Visit Data:",RJC,PAD)
    79         . D SFDISP(FIND0,13,16,"Rx Type:",RJC,PAD)
    80         . D SFDISP(FIND0,15,27,"Use Start Date:",RJC,PAD)
    81         . I $D(^PXRMD(811.5,D0,20,FINDING,5,0))=1 D
    82         .. S (SCNT,SIEN)=0
    83         .. F  S SIEN=$O(^PXRMD(811.5,D0,20,FINDING,5,SIEN)) Q:SIEN=""  D
    84         ... S STAT0=$G(^PXRMD(811.5,D0,20,FINDING,5,SIEN,0))
    85         ... D STATUS(STAT0,"Status List:") S SCNT=SCNT+1
    86         .;
    87         . S FIND0=$G(^PXRMD(811.5,D0,20,FINDING,3))
    88         . D SFDISP(FIND0,1,14,"Condition:",RJC,PAD)
    89         . D SFDISP(FIND0,2,15,"Condition Case Sensitive:",RJC,PAD)
    90         . D SFDISP(FIND0,3,18,"Use Status/Cond in Search:",RJC,PAD)
    91         . I $G(^PXRMD(811.5,D0,20,FINDING,15))'="" D
    92         .. S CFP=$$RJ^XLFSTR("Computed Finding Parameter:",RJC,PAD)
    93         .. S CFP=CFP_"  "_$G(^PXRMD(811.5,D0,20,FINDING,15))
    94         .. W !,CFP
    95         Q
    96         ;
    97         ;====================================================
    98 SFDISP(FIND0,PIECE,FLDNUM,TITLE,RJC,PAD)        ;Standard finding multiple
    99         ;field display.
    100         N FIELD,TEXT
    101         S FIELD=$P(FIND0,U,PIECE)
    102         I $L(FIELD)>0 D
    103         . S TEXT=$$RJ^XLFSTR(TITLE,RJC,PAD)
    104         . S TEXT=TEXT_"  "_$$EXTERNAL^DILFD(811.52,FLDNUM,"",FIELD,"")
    105         . I FLDNUM=13 S TEXT=TEXT_" - "_$$SPECIAL^PXRMPTDF(FIND0,FIELD)
    106         . W !,TEXT
    107         Q
    108         ;
    109         ;====================================================
    110 STATUS(STAT0,TITLE)     ; Status display
    111         I $L(STAT0)>0 D
    112         . N STATUS
    113         . I SCNT=0 S STATUS=$$RJ^XLFSTR(TITLE,RJC,PAD)
    114         . I SCNT>0 S STATUS=$$RJ^XLFSTR("",RJC,PAD)
    115         . S STATUS=STATUS_"  "_STAT0
    116         . W !,STATUS
    117         Q
    118         ;
    119         ;====================================================
    120 TFTYPE(VPTR)    ;Return Term finding type
    121         N ROOT,TFTYPE
    122         S ROOT=$P(VPTR,";",2)
    123         I '$D(PXRMFVPL) N PXRMFVPL D BLDRLIST^PXRMVPTR(811.52,.01,.PXRMFVPL)
    124         S TFTYPE=$P(PXRMFVPL(ROOT),U,2)
    125         Q TFTYPE
    126         ;
    127         ;====================================================
    128 TRMIEN(FINDING) ;Return internal entry number for TERM findings.
    129         N F0,IEN,PREFIX,ROOT,VPTR
    130         S ROOT="^PXRMD(811.5,D0,20,FINDING,0)"
    131         S F0=@ROOT
    132         S VPTR=$P(F0,U,1)
    133         S IEN=$P(VPTR,";",1)
    134         S ROOT=$P(VPTR,";",2)
    135         I '$D(PXRMFVPL) N PXRMFVPL D BLDRLIST^PXRMVPTR(811.52,.01,.PXRMFVPL)
    136         S VPTR=PXRMFVPL(ROOT)
    137         S PREFIX=$P(VPTR,U,4)
    138         Q " (FI("_+FINDING_")="_PREFIX_"("_IEN_"))"
    139         ;
     1PXRMPTTR ;SLC/PKR - Routines for term print templates ;01/30/2006
     2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
     3 ;
     4 ;====================================================
     5DATE(FIND0,PIECE,FLDNUM,TITLE,RJC,PAD,FILENUM,FLG) ;Standard DATE
     6 N DATE,TEXT
     7 S DATE=$P($G(FIND0),U,PIECE)
     8 I DATE'="" D
     9 . S DATE=$$FMTE^XLFDT(DATE,"D")
     10 . S TEXT=$$RJ^XLFSTR(TITLE,RJC,PAD)
     11 . S TEXT=TEXT_" "_DATE
     12 . W !,TEXT
     13 Q
     14 ;
     15 ;====================================================
     16GENIEN(FINDING) ;Return internal entry number for findings.
     17 N F0,IEN,PREFIX,ROOT,VPTR
     18 S ROOT="^PXRMD(811.5,D0,20,FINDING,0)"
     19 S F0=@ROOT
     20 S VPTR=$P(F0,U,1)
     21 S IEN=$P(VPTR,";",1)
     22 S ROOT=$P(VPTR,";",2)
     23 I '$D(PXRMFVPL) N PXRMFVPL D BLDRLIST^PXRMVPTR(811.52,.01,.PXRMFVPL)
     24 S VPTR=PXRMFVPL(ROOT)
     25 S PREFIX=$P(VPTR,U,4)
     26 Q " (FI("_+FINDING_")="_PREFIX_"("_IEN_"))"
     27 ;
     28 ;====================================================
     29ENTRYNAM(VPTR) ;Given the variable pointer return the entry name. The
     30 ;variable pointer list contains the information necessary to do the
     31 ;look up.
     32 N IEN,FILENUM,NAME,ROOT
     33 S IEN=$P(VPTR,";",1)
     34 S ROOT=$P(VPTR,";",2)
     35 S FILENUM=$P(PXRMFVPL(ROOT),U,1)
     36 S NAME=$$GET1^DIQ(FILENUM,IEN,.01,"","","")
     37 Q NAME
     38 ;
     39 ;====================================================
     40PFIND ;Print the reminder term finding multiple.
     41 N CFP,FIELD,FINDING,FIND0,HFCAT,HFIEN,PAD,PXRMFVPL
     42 N RJC,SCNT,SIEN,STAT0,TEXT
     43 ;If called by a FileMan print build the variable pointer list.
     44 I '$D(PXRMFVPL) N PXRMFVPL D BLDRLIST^PXRMVPTR(811.52,.01,.PXRMFVPL)
     45 S PAD=" ",RJC=31
     46 S FINDING=0
     47 F  S FINDING=$O(^PXRMD(811.5,D0,20,FINDING)) Q:+FINDING=0  D
     48 . S FIND0=^PXRMD(811.5,D0,20,FINDING,0)
     49 . S FIELD=$P(FIND0,U,1)
     50 . S TEXT=$$RJ^XLFSTR("Finding Item:",RJC,PAD)
     51 . S TEXT=TEXT_"  "_$$ENTRYNAM(FIELD)
     52 . S TEXT=TEXT_" "_$$TRMIEN(FINDING)
     53 . W !!,TEXT
     54 .;
     55 . S TEXT=$$RJ^XLFSTR("Finding Type:",RJC,PAD)
     56 . S TEXT=TEXT_"  "_$$TFTYPE(FIELD)
     57 . W !,TEXT
     58 . I FIND0["AUTTHF" D
     59 .. S HFIEN=$P($P(FIND0,U),";")
     60 .. S HFCAT=$P($G(^AUTTHF(HFIEN,0)),U,3)
     61 .. S HFCAT=$P($G(^AUTTHF(HFCAT,0)),U)
     62 .. S TEXT=$$RJ^XLFSTR("Health Factor Category:",RJC,PAD)
     63 .. S TEXT=TEXT_"  "_HFCAT
     64 .. W !,TEXT
     65 .;
     66 . S FIELD=$P(FIND0,U,4)
     67 . I $L(FIELD)>0 D
     68 .. S TEXT=$$RJ^XLFSTR("Match Frequency/Age:",RJC,PAD)
     69 .. S TEXT=TEXT_"  "_$$GENFREQ^PXRMPTD2(FIND0)
     70 .. W !,TEXT
     71 .;
     72 . D DATE(FIND0,8,9,"Beginning Date/Time:",RJC,PAD)
     73 . D DATE(FIND0,11,12,"Ending Date/Time Date:",RJC,PAD)
     74 . D SFDISP(FIND0,14,17,"Occurrence Count:",RJC,PAD)
     75 . D SFDISP(FIND0,9,10,"Use Inactive Problems:",RJC,PAD)
     76 . D SFDISP(FIND0,10,11,"Within Category Rank:",RJC,PAD)
     77 . D SFDISP(FIND0,12,13,"MH Scale:",RJC,PAD)
     78 . D SFDISP(FIND0,16,28,"Include Visit Data:",RJC,PAD)
     79 . D SFDISP(FIND0,13,16,"Rx Type:",RJC,PAD)
     80 . D SFDISP(FIND0,15,27,"Use Start Date:",RJC,PAD)
     81 . I $D(^PXRMD(811.5,D0,20,FINDING,5,0))=1 D
     82 .. S (SCNT,SIEN)=0
     83 .. F  S SIEN=$O(^PXRMD(811.5,D0,20,FINDING,5,SIEN)) Q:SIEN=""  D
     84 ... S STAT0=$G(^PXRMD(811.5,D0,20,FINDING,5,SIEN,0))
     85 ... D STATUS(STAT0,"Status List:") S SCNT=SCNT+1
     86 .;
     87 . S FIND0=$G(^PXRMD(811.5,D0,20,FINDING,3))
     88 . D SFDISP(FIND0,1,14,"Condition:",RJC,PAD)
     89 . D SFDISP(FIND0,2,15,"Condition Case Sensitive:",RJC,PAD)
     90 . D SFDISP(FIND0,3,18,"Use Cond in Finding Search:",RJC,PAD)
     91 . I $G(^PXRMD(811.5,D0,20,FINDING,15))'="" D
     92 .. S CFP=$$RJ^XLFSTR("Computed Finding Parameter:",RJC,PAD)
     93 .. S CFP=CFP_"  "_$G(^PXRMD(811.5,D0,20,FINDING,15))
     94 .. W !,CFP
     95 Q
     96 ;
     97 ;====================================================
     98SFDISP(FIND0,PIECE,FLDNUM,TITLE,RJC,PAD) ;Standard finding multiple
     99 ;field display.
     100 N FIELD,TEXT
     101 S FIELD=$P(FIND0,U,PIECE)
     102 I $L(FIELD)>0 D
     103 . S TEXT=$$RJ^XLFSTR(TITLE,RJC,PAD)
     104 . S TEXT=TEXT_"  "_$$EXTERNAL^DILFD(811.52,FLDNUM,"",FIELD,"")
     105 . W !,TEXT
     106 Q
     107 ;
     108 ;====================================================
     109STATUS(STAT0,TITLE) ; Status display
     110 I $L(STAT0)>0 D
     111 . N STATUS
     112 . I SCNT=0 S STATUS=$$RJ^XLFSTR(TITLE,RJC,PAD)
     113 . I SCNT>0 S STATUS=$$RJ^XLFSTR("",RJC,PAD)
     114 . S STATUS=STATUS_"  "_STAT0
     115 . W !,STATUS
     116 Q
     117 ;
     118 ;====================================================
     119TFTYPE(VPTR) ;Return Term finding type
     120 N ROOT,TFTYPE
     121 S ROOT=$P(VPTR,";",2)
     122 I '$D(PXRMFVPL) N PXRMFVPL D BLDRLIST^PXRMVPTR(811.52,.01,.PXRMFVPL)
     123 S TFTYPE=$P(PXRMFVPL(ROOT),U,2)
     124 Q TFTYPE
     125 ;
     126 ;====================================================
     127TRMIEN(FINDING) ;Return internal entry number for TERM findings.
     128 N F0,IEN,PREFIX,ROOT,VPTR
     129 S ROOT="^PXRMD(811.5,D0,20,FINDING,0)"
     130 S F0=@ROOT
     131 S VPTR=$P(F0,U,1)
     132 S IEN=$P(VPTR,";",1)
     133 S ROOT=$P(VPTR,";",2)
     134 I '$D(PXRMFVPL) N PXRMFVPL D BLDRLIST^PXRMVPTR(811.52,.01,.PXRMFVPL)
     135 S VPTR=PXRMFVPL(ROOT)
     136 S PREFIX=$P(VPTR,U,4)
     137 Q " (FI("_+FINDING_")="_PREFIX_"("_IEN_"))"
     138 ;
Note: See TracChangeset for help on using the changeset viewer.