- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIULMED.m
r613 r623 1 TIULMED ; SLC/JM,JH,AJB - Active/Recent Med Objects Routine ; 12/18/07 2 ;;1.0;TEXT INTEGRATION UTILITIES;**38,73,92,94,183,193,197,198,202,213,238**;Jun 20, 1997;Build 6 3 Q 4 LIST(DFN,TARGET,ACTVONLY,DETAILED,ALLMEDS,ONELIST,CLASSORT,SUPPLIES) ; 5 ; This is the TIU Medication objects API. Optional parameters not 6 ; provided default to 0 (with the exception of SUPPLIES). 7 ;Required Parameters: 8 ; DFN Patient identifier 9 ; TARGET Where the medication data will be stored 10 ;Optional Parameters: 11 ; ACTVONLY 0 - Active and recently expired meds 12 ; 1 - Active meds only 13 ; 2 - Recently expired meds only 14 ; DETAILED 0 - One line per med only 15 ; 1 - Detailed information on each med 16 ; ALLMEDS 0 - Specifies Inpatient Meds if patient is an 17 ; Inpatient, or Outpatient Meds if patient 18 ; is an Outpatient 19 ; 1 - Specifies both Inpatient and Outpatient 20 ; 2 or "I" - Specifies Inpatient only 21 ; 3 or "O" - Specifies Outpatient only 22 ; ONELIST 0 - Separates Active, Pending and Inactive 23 ; medications into separate lists 24 ; 1 - Combines Active, Pending and Inactive 25 ; medications into the same list 26 ; CLASSORT 0 - Sort meds alphabetically 27 ; 1 - Sort meds by drug class, and within the 28 ; same drug class, sort alphabetically 29 ; 2 - Same as #1, but show drug class in header 30 ; SUPPLIES 0 - Supplies are excluded 31 ; 1 - Supplies are included (Default) 32 N NEXTLINE,EMPTY,INDEX,NODE,ISINP,KEEPMED,STATUS,ASTATS,PSTATS,OK 33 N STATIDX,INPTYPE,OUTPTYPE,TYPE,MEDTYPE,MED,IDATE,XSTR,LLEN 34 N SPACE60,DASH73,LINE,TAB,HEADER 35 N DRUGCLAS,DRUGIDX,UNKNOWNS 36 N NVATYPE,NVAMED,NVASTR,TIUXSTAT 37 N %,%H,STOP,LSTFD ;Clean up after external calls... 38 S (NEXTLINE,TAB,HEADER,UNKNOWNS)=0,LLEN=47 39 S $P(SPACE60," ",60)=" ",$P(DASH73,"=",73)="=" 40 K @TARGET,^TMP("PS",$J) 41 ; Check for Pharmacy Package and required patches 42 I '$$PATCHSOK^TIULMED3 G LISTX ;P213 43 I '+$G(ACTVONLY) S ACTVONLY=0 44 I '+$G(DETAILED) S DETAILED=0 45 I +$D(ALLMEDS) D 46 .I ALLMEDS="I" S ALLMEDS=2 47 .E I ALLMEDS="O" S ALLMEDS=3 48 I '+$G(ALLMEDS) S ALLMEDS=0 49 I '+$G(ONELIST) S ONELIST=0 50 I '+$G(CLASSORT) S CLASSORT=0 51 I $G(SUPPLIES)'="0" S SUPPLIES=1 52 S (EMPTY,HEADER)=1 53 I ONELIST,'ALLMEDS,'DETAILED,'CLASSORT S HEADER=0 54 I 'DETAILED S LLEN=60 55 S ASTATS="^ACTIVE^REFILL^HOLD^PROVIDER HOLD^ON CALL^ACTIVE (S)^" 56 S PSTATS="^NON-VERIFIED^DRUG INTERACTIONS^INCOMPLETE^PENDING^" 57 S ISINP=($G(^DPT(DFN,.1))'="") ; Is this an inpatient? IA 10035 58 I ISINP S INPTYPE=1,OUTPTYPE=2 59 E S INPTYPE=2,OUTPTYPE=1 60 S NVATYPE=3 61 D ADDTITLE^TIULMED1 62 ; 63 ; *** Scan medication data and skip unwanted meds *** 64 ; Changes for *238 required by PSO*7*294 65 D 66 . I $$PATCH^XPDUTL("PSO*7.0*294"),+$D(TIUDATE) S TIUDATE=$$FMADD^XLFDT(DT,-$G(TIUDATE)) D OCL^PSOQ0496(DFN,TIUDATE,"") Q ; IA 2400 67 . D OCL^PSOORRL(DFN,"","") ; IA 2400 68 ; 69 S INDEX=0 70 F S INDEX=$O(^TMP("PS",$J,INDEX)) Q:INDEX'>0 D 71 .S NODE=$G(^TMP("PS",$J,INDEX,0)) 72 .S KEEPMED=($L($P(NODE,U,2))>0) ;Discard Blank Meds 73 .I KEEPMED D 74 ..S STATUS=$P(NODE,U,9) 75 ..I STATUS="ACTIVE/SUSP" S STATUS="ACTIVE (S)" 76 ..I $F(ASTATS,"^"_STATUS_"^")>0 S STATIDX=1 77 ..E I ($F(PSTATS,"^"_STATUS_"^")>0) S STATIDX=2 78 ..E S STATIDX=3 79 ..S TIUXSTAT=STATUS 80 ..I ACTVONLY=1 S KEEPMED=(STATIDX<3) 81 ..I ACTVONLY=2 S KEEPMED=(STATIDX=3) 82 ..I +ONELIST S STATIDX=1 83 ..; Changes for *238 required by PSO*7*294 84 ..I $$PATCH^XPDUTL("PSO*7.0*294"),+$D(TIUDATE),STATUS["DISCONTINUED" S KEEPMED=0 85 .I KEEPMED D 86 ..S TYPE=$P($P(NODE,U),";",2) 87 ..S TYPE=$S(TYPE="O":"OP",TYPE="I":"UD",1:"") 88 ..S NVAMED=$P($P(NODE,U),";") 89 ..S NVAMED=$E(NVAMED,$L(NVAMED)) 90 ..S KEEPMED=(TYPE'="") 91 .I KEEPMED D 92 ..I $O(^TMP("PS",$J,INDEX,"A",0))>0 S TYPE="IV" 93 ..E I $O(^TMP("PS",$J,INDEX,"B",0))>0 S TYPE="IV" 94 ..I TYPE="OP" S MEDTYPE=OUTPTYPE 95 ..E S MEDTYPE=INPTYPE 96 ..I NVAMED="N" S MEDTYPE=NVATYPE 97 ..I ALLMEDS=0 D I 1 98 ...I MEDTYPE=INPTYPE S KEEPMED=ISINP 99 ...E S KEEPMED='ISINP 100 ..E I ALLMEDS=2 S KEEPMED=(MEDTYPE=INPTYPE) 101 ..E I ALLMEDS=3 S KEEPMED=(MEDTYPE=OUTPTYPE!(MEDTYPE=NVATYPE)) 102 .S DRUGCLAS=" " 103 .S MED=$P(NODE,U,2) 104 .I KEEPMED,(CLASSORT!('SUPPLIES)) D 105 ..S DRUGIDX=$$IENNAME^TIULMED2(MED) 106 ..D GETCLASS 107 .. ; If DRUGIDX="" (MED not in Drug File 50), get info 108 .. ; via Orderable Item instead. 109 ..I KEEPMED,+DRUGIDX=0 D 110 ...N IDX,ID,ORDIDX,TMPCLASS,CDONE,SDONE,TMPIDX,TMPNODE,ISSUPPLY 111 ...S ID=$P(NODE,U),IDX=+ID,ID=$E(ID,$L(IDX)+1,$L(ID)) 112 ...S (DRUGIDX,ORDIDX)=0 113 ...K ^TMP($J,"TIULMED") 114 ...; IDX is Order #; ID indicates what file. See IA 2400 115 ...; R;O MED will always be in Drug File (Unless Drug File entry was 116 ...; changed after ordering. 117 ...I ID="R;O" D ;R;O = prescription (file #52). P213 118 ....D RX^PSO52API(DFN,"TIULMED",IDX,"","0,O") ; IA 4820 119 ....S DRUGIDX=+$G(^TMP($J,"TIULMED",DFN,IDX,6)) 120 ....S ORDIDX=+$G(^TMP($J,"TIULMED",DFN,IDX,"OI")) 121 ...; 122 ...I ID="P;O" D ;P;O = pending outpatient order (file #52.41). P213 123 ....D PEN^PSO5241(DFN,"TIULMED",IDX) ; IA 4821 124 ....S DRUGIDX=+$G(^TMP($J,"TIULMED",DFN,IDX,11)) 125 ....S ORDIDX=+$G(^TMP($J,"TIULMED",DFN,IDX,8)) 126 ...; 127 ...I ID="P;I" D ;P;I = pending inpatient order (file #53.1) 128 ....I $P($G(^PS(53.1,IDX,1,0)),U,4)=1 D ; IA 2907 129 .....S TMPIDX=$O(^PS(53.1,IDX,1,0)) I +TMPIDX D 130 ......S DRUGIDX=$P($G(^PS(53.1,IDX,1,TMPIDX,0)),U) 131 ....S ORDIDX=+$P($G(^PS(53.1,IDX,.2)),U) 132 ...; 133 ...I ID="U;I" D ;U;I = unit dose order (file #55, subfile 55.06) P213 134 ....D PSS431^PSS55(DFN,IDX,"","","TIULMED") ; IA 4826 135 ....I +$G(^TMP($J,"TIULMED",IDX,"DDRUG",0))=1 D 136 .....S TMPIDX=$O(^TMP($J,"TIULMED",IDX,"DDRUG",0)) Q:TMPIDX'>0 137 .....S DRUGIDX=+$G(^TMP($J,"TIULMED",IDX,"DDRUG",TMPIDX,.01)) 138 .....S ORDIDX=+$G(^TMP($J,"TIULMED",IDX,108)) 139 ...; 140 ...I ID="V;I" D ;V;I = IV order (file #55, subfile 55.01). P213 141 ....D PSS436^PSS55(DFN,IDX,"TIULMED") ; IA 4826 142 ....; Get ORDIDX before DRUGIDX since global is not there after DRUGIDX 143 ....S ORDIDX=+$G(^TMP($J,"TIULMED",IDX,130)) 144 ....I ^TMP($J,"TIULMED",IDX,"ADD",0)=1 D 145 .....S TMPIDX=$O(^TMP($J,"TIULMED",IDX,"ADD",0)) I +TMPIDX D 146 ......S TMPIDX=+$G(^TMP($J,"TIULMED",IDX,"ADD",TMPIDX,.01)) 147 ......I +TMPIDX S DRUGIDX=$$DRGIEN^TIULMED2(TMPIDX) ; IA 4662 148 ...; 149 ...S DRUGCLAS="" 150 ...D GETCLASS 151 ...I KEEPMED,+DRUGIDX=0,+ORDIDX,DRUGCLAS="" D 152 ....S IDX=0,ISSUPPLY=2,CDONE='CLASSORT,SDONE=+SUPPLIES 153 ....N LIST S LIST="TIULMED" K ^TMP($J,LIST) 154 ....D DRGIEN^PSS50P7(ORDIDX,"",LIST) ; IA 4662 155 ....F S IDX=$O(^TMP($J,LIST,IDX)) Q:'IDX D Q:(CDONE&SDONE) 156 .....S TMPCLASS=$$DRGCLASS^TIULMED2(IDX) 157 .....S TMPNODE=U_TMPCLASS_U_$$DEA^TIULMED2(IDX) 158 .....I 'CDONE,TMPCLASS="" S CDONE=1,DRUGCLAS="" 159 .....I 'CDONE D 160 ......I DRUGCLAS="" S DRUGCLAS=TMPCLASS 161 ......E I DRUGCLAS'=TMPCLASS S CDONE=1,DRUGCLAS="" 162 .....I 'SDONE D 163 ......S ISSUPPLY=(($E(TMPCLASS,1,2)="XA")&($P(TMPNODE,U,3)["S")) 164 ......I 'ISSUPPLY S SDONE=1 165 ....I 'SUPPLIES,(ISSUPPLY=1) S KEEPMED=0 166 ..I (DRUGCLAS="")!('CLASSORT) S DRUGCLAS=" " 167 .; 168 .; *** Save wanted meds in "B" temp xref, removing duplicates *** 169 .; 170 .I KEEPMED D 171 ..D ADDMED^TIULMED1(1) ; Get XSTR to check for duplicates 172 ..;VMP OIFO BAY PINES;ELR;TIU*1.0*198;ADDED TIUXSTAT TO TMP GLOBAL 173 ..S IDATE=$P(NODE,U,15) 174 ..S OK='$D(@TARGET@("B",MED,XSTR,TIUXSTAT)) 175 ..I 'OK,(IDATE>@TARGET@("B",MED,XSTR,TIUXSTAT)) S OK=1 176 ..I OK D 177 ...S @TARGET@("B",MED,XSTR,TIUXSTAT)=IDATE_U_INDEX_U_MEDTYPE_STATIDX_U_TYPE_U_DRUGCLAS 178 ...S EMPTY=0 179 ...I DRUGCLAS=" " S UNKNOWNS=1 180 ; 181 D SORTSAVE^TIULMED3 K @TARGET@("B"),@TARGET@("C") ;P213 182 LISTX K ^TMP("PS",$J),^TMP($J,"TIULMED"),TIUDATE ; K TIUDATE added for PSO*7*294 183 Q "~@"_$NA(@TARGET) 184 ; 185 GETCLASS ; 186 D GETCLASS^TIULMED3 187 Q 1 TIULMED ; SLC/JM,JH - Active/Recent Med Objects Routine ;1/23/07 2 ;;1.0;TEXT INTEGRATION UTILITIES;**38,73,92,94,183,193,197,198,202,213**;Jun 20, 1997;Build 3 3 Q 4 LIST(DFN,TARGET,ACTVONLY,DETAILED,ALLMEDS,ONELIST,CLASSORT,SUPPLIES) ; 5 ; This is the TIU Medication objects API. Optional parameters not 6 ; provided default to 0 (with the exception of SUPPLIES). 7 ;Required Parameters: 8 ; DFN Patient identifier 9 ; TARGET Where the medication data will be stored 10 ;Optional Parameters: 11 ; ACTVONLY 0 - Active and recently expired meds 12 ; 1 - Active meds only 13 ; 2 - Recently expired meds only 14 ; DETAILED 0 - One line per med only 15 ; 1 - Detailed information on each med 16 ; ALLMEDS 0 - Specifies Inpatient Meds if patient is an 17 ; Inpatient, or Outpatient Meds if patient 18 ; is an Outpatient 19 ; 1 - Specifies both Inpatient and Outpatient 20 ; 2 or "I" - Specifies Inpatient only 21 ; 3 or "O" - Specifies Outpatient only 22 ; ONELIST 0 - Separates Active, Pending and Inactive 23 ; medications into separate lists 24 ; 1 - Combines Active, Pending and Inactive 25 ; medications into the same list 26 ; CLASSORT 0 - Sort meds alphabetically 27 ; 1 - Sort meds by drug class, and within the 28 ; same drug class, sort alphabetically 29 ; 2 - Same as #1, but show drug class in header 30 ; SUPPLIES 0 - Supplies are excluded 31 ; 1 - Supplies are included (Default) 32 N NEXTLINE,EMPTY,INDEX,NODE,ISINP,KEEPMED,STATUS,ASTATS,PSTATS,OK 33 N STATIDX,INPTYPE,OUTPTYPE,TYPE,MEDTYPE,MED,IDATE,XSTR,LLEN 34 N SPACE60,DASH73,LINE,TAB,HEADER 35 N DRUGCLAS,DRUGIDX,UNKNOWNS 36 N NVATYPE,NVAMED,NVASTR,TIUXSTAT 37 N %,%H,STOP,LSTFD ;Clean up after external calls... 38 S (NEXTLINE,TAB,HEADER,UNKNOWNS)=0,LLEN=47 39 S $P(SPACE60," ",60)=" ",$P(DASH73,"=",73)="=" 40 K @TARGET,^TMP("PS",$J) 41 ; Check for Pharmacy Package and required patches 42 I '$$PATCHSOK^TIULMED3 G LISTX ;P213 43 I '+$G(ACTVONLY) S ACTVONLY=0 44 I '+$G(DETAILED) S DETAILED=0 45 I +$D(ALLMEDS) D 46 .I ALLMEDS="I" S ALLMEDS=2 47 .E I ALLMEDS="O" S ALLMEDS=3 48 I '+$G(ALLMEDS) S ALLMEDS=0 49 I '+$G(ONELIST) S ONELIST=0 50 I '+$G(CLASSORT) S CLASSORT=0 51 I $G(SUPPLIES)'="0" S SUPPLIES=1 52 S (EMPTY,HEADER)=1 53 I ONELIST,'ALLMEDS,'DETAILED,'CLASSORT S HEADER=0 54 I 'DETAILED S LLEN=60 55 S ASTATS="^ACTIVE^REFILL^HOLD^PROVIDER HOLD^ON CALL^ACTIVE (S)^" 56 S PSTATS="^NON-VERIFIED^DRUG INTERACTIONS^INCOMPLETE^PENDING^" 57 S ISINP=($G(^DPT(DFN,.1))'="") ; Is this an inpatient? IA 10035 58 I ISINP S INPTYPE=1,OUTPTYPE=2 59 E S INPTYPE=2,OUTPTYPE=1 60 S NVATYPE=3 61 D ADDTITLE^TIULMED1 62 ; 63 ; *** Scan medication data and skip unwanted meds *** 64 ; 65 D OCL^PSOORRL(DFN,"","") ; IA 2400 66 S INDEX=0 67 F S INDEX=$O(^TMP("PS",$J,INDEX)) Q:INDEX'>0 D 68 .S NODE=$G(^TMP("PS",$J,INDEX,0)) 69 .S KEEPMED=($L($P(NODE,U,2))>0) ;Discard Blank Meds 70 .I KEEPMED D 71 ..S STATUS=$P(NODE,U,9) 72 ..I STATUS="ACTIVE/SUSP" S STATUS="ACTIVE (S)" 73 ..I $F(ASTATS,"^"_STATUS_"^")>0 S STATIDX=1 74 ..E I ($F(PSTATS,"^"_STATUS_"^")>0) S STATIDX=2 75 ..E S STATIDX=3 76 ..S TIUXSTAT=STATUS 77 ..I ACTVONLY=1 S KEEPMED=(STATIDX<3) 78 ..I ACTVONLY=2 S KEEPMED=(STATIDX=3) 79 ..I +ONELIST S STATIDX=1 80 .I KEEPMED D 81 ..S TYPE=$P($P(NODE,U),";",2) 82 ..S TYPE=$S(TYPE="O":"OP",TYPE="I":"UD",1:"") 83 ..S NVAMED=$P($P(NODE,U),";") 84 ..S NVAMED=$E(NVAMED,$L(NVAMED)) 85 ..S KEEPMED=(TYPE'="") 86 .I KEEPMED D 87 ..I $O(^TMP("PS",$J,INDEX,"A",0))>0 S TYPE="IV" 88 ..E I $O(^TMP("PS",$J,INDEX,"B",0))>0 S TYPE="IV" 89 ..I TYPE="OP" S MEDTYPE=OUTPTYPE 90 ..E S MEDTYPE=INPTYPE 91 ..I NVAMED="N" S MEDTYPE=NVATYPE 92 ..I ALLMEDS=0 D I 1 93 ...I MEDTYPE=INPTYPE S KEEPMED=ISINP 94 ...E S KEEPMED='ISINP 95 ..E I ALLMEDS=2 S KEEPMED=(MEDTYPE=INPTYPE) 96 ..E I ALLMEDS=3 S KEEPMED=(MEDTYPE=OUTPTYPE!(MEDTYPE=NVATYPE)) 97 .S DRUGCLAS=" " 98 .S MED=$P(NODE,U,2) 99 .I KEEPMED,(CLASSORT!('SUPPLIES)) D 100 ..S DRUGIDX=$$IENNAME^TIULMED2(MED) 101 ..D GETCLASS 102 .. ; If DRUGIDX="" (MED not in Drug File 50), get info 103 .. ; via Orderable Item instead. 104 ..I KEEPMED,+DRUGIDX=0 D 105 ...N IDX,ID,ORDIDX,TMPCLASS,CDONE,SDONE,TMPIDX,TMPNODE,ISSUPPLY 106 ...S ID=$P(NODE,U),IDX=+ID,ID=$E(ID,$L(IDX)+1,$L(ID)) 107 ...S (DRUGIDX,ORDIDX)=0 108 ...K ^TMP($J,"TIULMED") 109 ...; IDX is Order #; ID indicates what file. See IA 2400 110 ...; R;O MED will always be in Drug File (Unless Drug File entry was 111 ...; changed after ordering. 112 ...I ID="R;O" D ;R;O = prescription (file #52). P213 113 ....D RX^PSO52API(DFN,"TIULMED",IDX,"","0,O") ; IA 4820 114 ....S DRUGIDX=+$G(^TMP($J,"TIULMED",DFN,IDX,6)) 115 ....S ORDIDX=+$G(^TMP($J,"TIULMED",DFN,IDX,"OI")) 116 ...; 117 ...I ID="P;O" D ;P;O = pending outpatient order (file #52.41). P213 118 ....D PEN^PSO5241(DFN,"TIULMED",IDX) ; IA 4821 119 ....S DRUGIDX=+$G(^TMP($J,"TIULMED",DFN,IDX,11)) 120 ....S ORDIDX=+$G(^TMP($J,"TIULMED",DFN,IDX,8)) 121 ...; 122 ...I ID="P;I" D ;P;I = pending inpatient order (file #53.1) 123 ....I $P($G(^PS(53.1,IDX,1,0)),U,4)=1 D ; IA 2907 124 .....S TMPIDX=$O(^PS(53.1,IDX,1,0)) I +TMPIDX D 125 ......S DRUGIDX=$P($G(^PS(53.1,IDX,1,TMPIDX,0)),U) 126 ....S ORDIDX=+$P($G(^PS(53.1,IDX,.2)),U) 127 ...; 128 ...I ID="U;I" D ;U;I = unit dose order (file #55, subfile 55.06) P213 129 ....D PSS431^PSS55(DFN,IDX,"","","TIULMED") ; IA 4826 130 ....I +$G(^TMP($J,"TIULMED",IDX,"DDRUG",0))=1 D 131 .....S TMPIDX=$O(^TMP($J,"TIULMED",IDX,"DDRUG",0)) Q:TMPIDX'>0 132 .....S DRUGIDX=+$G(^TMP($J,"TIULMED",IDX,"DDRUG",TMPIDX,.01)) 133 .....S ORDIDX=+$G(^TMP($J,"TIULMED",IDX,108)) 134 ...; 135 ...I ID="V;I" D ;V;I = IV order (file #55, subfile 55.01). P213 136 ....D PSS436^PSS55(DFN,IDX,"TIULMED") ; IA 4826 137 ....; Get ORDIDX before DRUGIDX since global is not there after DRUGIDX 138 ....S ORDIDX=+$G(^TMP($J,"TIULMED",IDX,130)) 139 ....I ^TMP($J,"TIULMED",IDX,"ADD",0)=1 D 140 .....S TMPIDX=$O(^TMP($J,"TIULMED",IDX,"ADD",0)) I +TMPIDX D 141 ......S TMPIDX=+$G(^TMP($J,"TIULMED",IDX,"ADD",TMPIDX,.01)) 142 ......I +TMPIDX S DRUGIDX=$$DRGIEN^TIULMED2(TMPIDX) ; IA 4662 143 ...; 144 ...S DRUGCLAS="" 145 ...D GETCLASS 146 ...I KEEPMED,+DRUGIDX=0,+ORDIDX,DRUGCLAS="" D 147 ....S IDX=0,ISSUPPLY=2,CDONE='CLASSORT,SDONE=+SUPPLIES 148 ....N LIST S LIST="TIULMED" K ^TMP($J,LIST) 149 ....D DRGIEN^PSS50P7(ORDIDX,"",LIST) ; IA 4662 150 ....F S IDX=$O(^TMP($J,LIST,IDX)) Q:'IDX D Q:(CDONE&SDONE) 151 .....S TMPCLASS=$$DRGCLASS^TIULMED2(IDX) 152 .....S TMPNODE=U_TMPCLASS_U_$$DEA^TIULMED2(IDX) 153 .....I 'CDONE,TMPCLASS="" S CDONE=1,DRUGCLAS="" 154 .....I 'CDONE D 155 ......I DRUGCLAS="" S DRUGCLAS=TMPCLASS 156 ......E I DRUGCLAS'=TMPCLASS S CDONE=1,DRUGCLAS="" 157 .....I 'SDONE D 158 ......S ISSUPPLY=(($E(TMPCLASS,1,2)="XA")&($P(TMPNODE,U,3)["S")) 159 ......I 'ISSUPPLY S SDONE=1 160 ....I 'SUPPLIES,(ISSUPPLY=1) S KEEPMED=0 161 ..I (DRUGCLAS="")!('CLASSORT) S DRUGCLAS=" " 162 .; 163 .; *** Save wanted meds in "B" temp xref, removing duplicates *** 164 .; 165 .I KEEPMED D 166 ..D ADDMED^TIULMED1(1) ; Get XSTR to check for duplicates 167 ..;VMP OIFO BAY PINES;ELR;TIU*1.0*198;ADDED TIUXSTAT TO TMP GLOBAL 168 ..S IDATE=$P(NODE,U,15) 169 ..S OK='$D(@TARGET@("B",MED,XSTR,TIUXSTAT)) 170 ..I 'OK,(IDATE>@TARGET@("B",MED,XSTR,TIUXSTAT)) S OK=1 171 ..I OK D 172 ...S @TARGET@("B",MED,XSTR,TIUXSTAT)=IDATE_U_INDEX_U_MEDTYPE_STATIDX_U_TYPE_U_DRUGCLAS 173 ...S EMPTY=0 174 ...I DRUGCLAS=" " S UNKNOWNS=1 175 ; 176 D SORTSAVE^TIULMED3 K @TARGET@("B"),@TARGET@("C") ;P213 177 LISTX K ^TMP("PS",$J),^TMP($J,"TIULMED") 178 Q "~@"_$NA(@TARGET) 179 ; 180 GETCLASS ; 181 D GETCLASS^TIULMED3 182 Q
Note:
See TracChangeset
for help on using the changeset viewer.
