Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEUT1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEUT1.m
r613 r623 1 PXRMEUT1 ; SLC/PKR - General extract utilities ;05/08/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 ;================================================= 4 CLDATES ;Cleanup entries in ^TMP("PXRMDDOC",$J) before making date checks. 5 ;For drug findings consolidate PS(55, PS(55NVA, and PSRX( back to 6 ;PSDRUG(. 7 N FI,FIND0,ITEM,GLOBAL,LIST 8 S FIND0="" 9 F S FIND0=$O(^TMP("PXRMDDOC",$J,FIND0)) Q:FIND0="" D 10 . S FI=$P(FIND0,U,1) 11 . S GLOBAL=$P(FI,";",2) 12 . I GLOBAL'["PS" Q 13 . S GLOBAL="PSDRUG(" 14 . S ITEM=$P(FI,";",1) 15 . S FI=ITEM_";"_GLOBAL_U_$P(FIND0,U,2,11) 16 . S LIST(FIND0)=FI 17 ; 18 S FIND0="" 19 F S FIND0=$O(LIST(FIND0)) Q:FIND0="" D 20 . S FI=LIST(FIND0) 21 . S ^TMP("PXRMDDOC",$J,FI)=^TMP("PXRMDDOC",$J,FIND0) 22 . K ^TMP("PXRMDDOC",$J,FIND0) 23 Q 24 ; 25 ;================================================= 26 DAYSIM(FMDATE) ;Given a FileMan date return the number of days in the month. 27 N MONTH 28 S MONTH=$E(FMDATE,4,5) 29 S DAYS=$S(MONTH="01":31,MONTH="02":28,MONTH="03":31,MONTH="04":30,MONTH="05":31,MONTH="06":30,MONTH="07":31,MONTH="08":31,MONTH="09":30,MONTH="10":31,MONTH="11":30,MONTH="12":31,1:"") 30 I MONTH="02" D 31 . N LYEAR,YEAR 32 . S YEAR=$E(FMDATE,1,3)+1700 33 . S LYEAR=$S((YEAR#4=0)&(YEAR#100'=0):1,YEAR#400=0:1,1:0) 34 . I LYEAR S DAYS=29 35 Q DAYS 36 ; 37 ;================================================= 38 DCONV(DATE,LBBDT,LBEDT) ;Convert dates to actual values. 39 I DATE=0 Q DATE 40 N PXRMDATE 41 S PXRMDATE=$S(DATE["BDT":LBBDT,1:LBEDT) 42 S DATE=$$STRREP^PXRMUTIL(DATE,"BDT","T") 43 Q $$CTFMD^PXRMDATE(DATE) 44 ; 45 ;================================================= 46 DOCDATES(RULESET,LBBDT,LBEDT,NL,OUTPUT) ; 47 N EM,FRACT,FRDATA,FRDATES,FRIEN,FRLST,FRLIEN,FROLST,FROUT,FRPAT 48 N FRPERM,FRSTRT,FRTIEN,FRTYP,FSEQ,OPER,PXRMFVPL 49 N RRIEN,RSDATA,RSDATES,RBDT,REDT,SEQ,SUB 50 I $G(PXRMDDOC)=2 D CLDATES 51 ;Build the variable pointer list. 52 D BLDRLIST^PXRMVPTR(811.902,.01,.PXRMFVPL) 53 S SEQ="",NL=0 54 F S SEQ=$O(^PXRM(810.4,RULESET,30,"B",SEQ)) Q:'SEQ D 55 . S SUB=$O(^PXRM(810.4,RULESET,30,"B",SEQ,"")) Q:'SUB 56 . S RSDATA=$G(^PXRM(810.4,RULESET,30,SUB,0)) Q:RSDATA="" 57 . S OPER=$P(RSDATA,U,3) 58 . S OPER=$$EXTERNAL^DILFD(810.41,.03,"",OPER,.EM) 59 . S RSDATES=$G(^PXRM(810.4,RULESET,30,SUB,1)) 60 .;Finding rule ien. 61 . S FRIEN=$P(RSDATA,U,2) Q:'FRIEN 62 .;Check if entry is a finding rule (not a set or reminder rule) 63 . S FRDATA=$G(^PXRM(810.4,FRIEN,0)),FRTYP=$P(FRDATA,U,3) Q:FRTYP=3 64 . S FRDATES=$P(FRDATA,U,4,5) 65 .;Get term IEN for finding rule 66 . I FRTYP=1 S FRTIEN=$P(FRDATA,U,7) Q:'FRTIEN 67 .;Get Reminder definition IEN for Reminder rule 68 . I FRTYP=2 S RRIEN=$P(FRDATA,U,10) Q:'RRIEN 69 .;Determine RBDT and REDT 70 . D RDATES(RSDATES,FRDATES,LBBDT,LBEDT,.RBDT,.REDT) 71 . S NL=NL+1,OUTPUT(NL)="" 72 . S NL=NL+1,OUTPUT(NL)="SEQUENCE "_SEQ_" "_$P(FRDATA,U,1) 73 . S NL=NL+1,OUTPUT(NL)=" Operation: "_OPER 74 .;Term finding rules 75 . I FRTYP=1 D TERM(FRTIEN,LBBDT,LBEDT,RBDT,REDT,.PXRMFVPL,.NL,.OUTPUT) 76 .;Reminder Definition List Rule 77 . I FRTYP=2 D REM(RRIEN,LBBDT,LBEDT,RBDT,REDT,.PXRMFVPL,.NL,.OUTPUT) 78 Q 79 ; 80 ;================================================= 81 FMULPRT(FARR,PXRMFVPL,NL,OUTPUT) ;Print the finding multiple 82 ;information. 83 ;Q 84 N BDT,EDT,DERROR,FNAME,FTYPE,IND,NOCC,TBDT,TEDT,TEMP,VPTR 85 S IND=0 86 F S IND=+$O(FARR(20,IND)) Q:IND=0 D 87 . S VPTR=$P(FARR(20,IND,0),U,1) 88 . S FNAME=$$ENTRYNAM^PXRMPTD2(VPTR) 89 . S FTYPE=$$FTYPE^PXRMPTD2(VPTR,1) 90 . S NL=NL+1,OUTPUT(NL)=" FINDING "_IND_"-"_FTYPE_"."_FNAME 91 .;Set the finding parameters. 92 . D SSPAR^PXRMUTIL(FARR(20,IND,0),.NOCC,.BDT,.EDT) 93 . S NL=NL+1,OUTPUT(NL)=" Beginning Date/Time: "_$$FMTE^XLFDT(BDT,"5Z") 94 . S NL=NL+1,OUTPUT(NL)=" Ending Date/Time: "_$$FMTE^XLFDT(EDT,"5Z") 95 . I $G(PXRMDDOC)'=2 Q 96 . S DERROR=0 97 . S TEMP=$G(^TMP("PXRMDDOC",$J,$P(FARR(20,IND,0),U,1,11))) 98 .;If TEMP is null then no evaluation was required and the check 99 .;cannot be made 100 . I TEMP="" Q 101 . I $P(TEMP,U,1)'=BDT D 102 .. S DERROR=1 103 .. S NL=NL+1,OUTPUT(NL)=" There is a consistency problem with the beginning date!" 104 .. S NL=NL+1,OUTPUT(NL)=" Date used to build the list was: "_$$FMTE^XLFDT($P(TEMP,U,1),"5Z") 105 . I $P(TEMP,U,2)'=EDT D 106 .. S DERROR=1 107 .. S NL=NL+1,OUTPUT(NL)=" There is a consistency problem with the ending date!" 108 .. S NL=NL+1,OUTPUT(NL)=" Date used to build the list was: "_$$FMTE^XLFDT($P(TEMP,U,2),"5Z") 109 . I DERROR D 110 .. S NL=NL+1,OUTPUT(NL)=" Please notify the developers." 111 .. ;S NL=NL+1,OUTPUT(NL)=" Please enter a Remedy ticket." 112 .. S NL=NL+1,OUTPUT(NL)=" " 113 Q 114 ; 115 ;================================================= 116 RDATES(RSDATES,FRDATES,LBBDT,LBEDT,RBDT,REDT) ;Determine the beginning and 117 ;ending dates. 118 ;Date precedence: LIST BUILD < RULE SET < FINDING RULE < TERM/REMINDER 119 S RBDT=$P(FRDATES,U,1),REDT=$P(FRDATES,U,2) 120 I RBDT="",REDT="" S RBDT=$P(RSDATES,U,1),REDT=$P(RSDATES,U,2) 121 I RBDT="",REDT="" S RBDT=LBBDT,REDT=LBEDT 122 I RBDT="" S RBDT=0 123 I REDT="" S REDT=LBEDT 124 I REDT=0 S REDT=DT 125 ;Convert RBDT and REDT to FileMan dates. 126 S RBDT=$$DCONV(RBDT,LBBDT,LBEDT) 127 S REDT=$$DCONV(REDT,LBBDT,LBEDT) 128 ;If the month is missing use January for the beginning date and 129 ;December for the ending date. 130 I $E(RBDT,4,5)="00" S RBDT=$E(RBDT,1,3)_"01"_$E(RBDT,6,7) 131 I $E(REDT,4,5)="00" S REDT=$E(REDT,1,3)_"12"_$E(REDT,6,7) 132 ;If the day is missing use the first for beginning date and the end 133 ;of the month for ending date. 134 I $E(RBDT,6,7)="00" S RBDT=$E(RBDT,1,5)_"01" 135 I $E(REDT,6,7)="00" S REDT=$E(REDT,1,5)_$$DAYSIM(REDT) 136 Q 137 ; 138 ;================================================= 139 REM(IEN,LBBDT,LBEDT,RBDT,REDT,PXRMFVPL,NL,OUTPUT) ; 140 N DEFARR 141 D DEF^PXRMLDR(IEN,.DEFARR) 142 D DATES^PXRMRUL1(LBBDT,LBEDT,RBDT,REDT,.DEFARR) 143 S NL=NL+1,OUTPUT(NL)=" REMINDER DEFINITION "_$P(DEFARR(0),U,1) 144 D FMULPRT(.DEFARR,.PXRMFVPL,.NL,.OUTPUT) 145 Q 146 ; 147 ;================================================= 148 TERM(IEN,LBBDT,LBEDT,RBDT,REDT,PXRMFVPL,NL,OUTPUT) ; 149 N TERMARR 150 D TERM^PXRMLDR(IEN,.TERMARR) 151 D DATES^PXRMRUL1(LBBDT,LBEDT,RBDT,REDT,.TERMARR) 152 S NL=NL+1,OUTPUT(NL)=" TERM "_$P(TERMARR(0),U,1) 153 D FMULPRT(.TERMARR,.PXRMFVPL,.NL,.OUTPUT) 154 Q 155 ; 1 PXRMEUT1 ; SLC/PKR - General extract utilities ;08/09/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ;================================================= 4 DCONV(DATE,LBBDT,LBEDT) ;Convert dates to actual values. 5 I DATE=0 Q DATE 6 N PXRMDATE 7 S PXRMDATE=$S(DATE["BDT":LBBDT,1:LBEDT) 8 S DATE=$$STRREP^PXRMUTIL(DATE,"BDT","T") 9 Q $$CTFMD^PXRMDATE(DATE) 10 ; 11 ;================================================= 12 DAYSIM(FMDATE) ;Given a FileMan date return the number of days in the month. 13 N MONTH 14 S MONTH=$E(FMDATE,4,5) 15 S DAYS=$S(MONTH="01":31,MONTH="02":28,MONTH="03":31,MONTH="04":30,MONTH="05":31,MONTH="06":30,MONTH="07":31,MONTH="08":31,MONTH="09":30,MONTH="10":31,MONTH="11":30,MONTH="12":31,1:"") 16 I MONTH="02" D 17 . N LYEAR,YEAR 18 . S YEAR=$E(FMDATE,1,3)+1700 19 . S LYEAR=$S((YEAR#4=0)&(YEAR#100'=0):1,YEAR#400=0:1,1:0) 20 . I LYEAR S DAYS=29 21 Q DAYS 22 ; 23 ;================================================= 24 DOCDATES(RULESET,LBBDT,LBEDT,NL,OUTPUT) ; 25 N FINDPA,FRACT,FRDATA,FRDATES,FRIEN,FRLST,FRLIEN,FROLST,FROUT,FRPAT 26 N FRPERM,FRSTRT,FRTIEN,FRTYP,FSEQ,PXRMDATE,PXRMFVPL 27 N RRIEN,RSDATA,RSDATES,RBDT,REDT,SEQ,SUB 28 ;Build the variable pointer list. 29 D BLDRLIST^PXRMVPTR(811.902,.01,.PXRMFVPL) 30 S SEQ="",NL=0 31 F S SEQ=$O(^PXRM(810.4,RULESET,30,"B",SEQ)) Q:'SEQ D 32 . S SUB=$O(^PXRM(810.4,RULESET,30,"B",SEQ,"")) Q:'SUB 33 . S RSDATA=$G(^PXRM(810.4,RULESET,30,SUB,0)) Q:RSDATA="" 34 . S RSDATES=$G(^PXRM(810.4,RULESET,30,SUB,1)) 35 .;Finding rule ien. 36 . S FRIEN=$P(RSDATA,U,2) Q:'FRIEN 37 .;Check if entry is a finding rule (not a set or reminder rule) 38 . S FRDATA=$G(^PXRM(810.4,FRIEN,0)),FRTYP=$P(FRDATA,U,3) Q:FRTYP=3 39 . S FRDATES=$P(FRDATA,U,4,5) 40 .;Get term IEN for finding rule 41 . I FRTYP=1 S FRTIEN=$P(FRDATA,U,7) Q:'FRTIEN 42 .;Get Reminder definition IEN for Reminder rule 43 . I FRTYP=2 S RRIEN=$P(FRDATA,U,10) Q:'RRIEN 44 .;Determine RBDT and REDT 45 . D RDATES(RSDATES,FRDATES,LBBDT,LBEDT,.RBDT,.REDT) 46 . S PXRMDATE=LBEDT 47 . S $P(FINDPA(0),U,8)=RBDT,$P(FINDPA(0),U,11)=REDT 48 . S NL=NL+1,OUTPUT(NL)="" 49 . S NL=NL+1,OUTPUT(NL)="SEQUENCE "_SEQ_" "_$P(FRDATA,U,1) 50 .;Term finding rules 51 . I FRTYP=1 D TERM(FRTIEN,.FINDPA,.PXRMFVPL,.NL,.OUTPUT) 52 .;Reminder Definition List Rule 53 . I FRTYP=2 D REM(RRIEN,.FINDPA,.PXRMFVPL,.NL,.OUTPUT) 54 Q 55 ; 56 ;================================================= 57 FMULPRT(DEFARR,FINDPA,PXRMFVPL,NL,OUTPUT) ;Print the finding multiple 58 ;information. 59 N BDT,EDT,FNAME,FTYPE,IND,NOCC,PFINDPA,TFINDPA,VPTR 60 S IND=0 61 F S IND=+$O(DEFARR(20,IND)) Q:IND=0 D 62 . S VPTR=$P(DEFARR(20,IND,0),U,1) 63 . S FNAME=$$ENTRYNAM^PXRMPTD2(VPTR) 64 . S FTYPE=$$FTYPE^PXRMPTD2(VPTR,1) 65 . S NL=NL+1,OUTPUT(NL)=" FINDING "_IND_"-"_FTYPE_"."_FNAME 66 . K PFINDPA,TFINDPA 67 . M TFINDPA=DEFARR(20,IND) 68 .;Set the finding parameters. 69 . D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA) 70 . D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT) 71 . S NL=NL+1,OUTPUT(NL)=" Beginning Date/Time: "_$$FMTE^XLFDT(BDT,"5Z") 72 . S NL=NL+1,OUTPUT(NL)=" Ending Date/Time: "_$$FMTE^XLFDT(EDT,"5Z") 73 Q 74 ; 75 ;================================================= 76 RDATES(RSDATES,FRDATES,LBBDT,LBEDT,RBDT,REDT) ;Determine the beginning and 77 ;ending dates. 78 ;Date precedence: LIST BUILD < RULE SET < FINDING RULE < TERM/REMINDER 79 S RBDT=$P(FRDATES,U,1),REDT=$P(FRDATES,U,2) 80 I RBDT="",REDT="" S RBDT=$P(RSDATES,U,1),REDT=$P(RSDATES,U,2) 81 I RBDT="",REDT="" S RBDT=LBBDT,REDT=LBEDT 82 I RBDT="" S RBDT=0 83 I REDT="" S REDT=LBEDT 84 I REDT=0 S REDT=$$DT^XLFDT 85 ;Convert RBDT and REDT to FileMan dates. 86 S RBDT=$$DCONV(RBDT,LBBDT,LBEDT) 87 S REDT=$$DCONV(REDT,LBBDT,LBEDT) 88 ;If the month is missing use January for the beginning date and 89 ;December for the ending date. 90 I $E(RBDT,4,5)="00" S RBDT=$E(RBDT,1,3)_"01"_$E(RBDT,6,7) 91 I $E(REDT,4,5)="00" S REDT=$E(REDT,1,3)_"12"_$E(REDT,6,7) 92 ;If the day is missing use the first for beginning date and the end 93 ;of the month for ending date. 94 I $E(RBDT,6,7)="00" S RBDT=$E(RBDT,1,5)_"01" 95 I $E(REDT,6,7)="00" S REDT=$E(REDT,1,5)_$$DAYSIM(REDT) 96 Q 97 ; 98 ;================================================= 99 REM(IEN,FINDPA,PXRMFVPL,NL,OUTPUT) ; 100 N DEFARR 101 D DEF^PXRMLDR(IEN,.DEFARR) 102 S NL=NL+1,OUTPUT(NL)=" REMINDER DEFINITION "_$P(DEFARR(0),U,1) 103 D FMULPRT(.DEFARR,.FINDPA,.PXRMFVPL,.NL,.OUTPUT) 104 Q 105 ; 106 ;================================================= 107 TERM(IEN,FINDPA,PXRMFVPL,NL,OUTPUT) ; 108 N TERMARR 109 D TERM^PXRMLDR(IEN,.TERMARR) 110 S NL=NL+1,OUTPUT(NL)=" TERM "_$P(TERMARR(0),U,1) 111 D FMULPRT(.TERMARR,.FINDPA,.PXRMFVPL,.NL,.OUTPUT) 112 Q 113 ;
Note:
See TracChangeset
for help on using the changeset viewer.
