Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMPTTR.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- 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 ; 1 PXRMPTTR ;SLC/PKR - Routines for term print templates ;01/30/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 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 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 ;==================================================== 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 . W !,TEXT 106 Q 107 ; 108 ;==================================================== 109 STATUS(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 ;==================================================== 119 TFTYPE(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 ;==================================================== 127 TRMIEN(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.