- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDX1.m
r613 r623 1 ORWDX1 ; SLC/KCM/REV - Utilities for Order Dialogs ;06/06/2007 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,187,195,215,243**;Dec 17, 1997;Build 242 3 ; 4 WRLST(LST,LOC) ; Return list of dialogs for writing orders 5 ; .Y(n): DlgName^ListBox Text 6 WRLST1 N ANENT 7 S LOC=+$G(LOC)_";SC(" I 'LOC S LOC="" 8 S ANENT="ALL^"_LOC_$S($G(^VA(200,DUZ,5)):"^SRV.`"_+$G(^(5)),1:"") 9 D WRLSTB(.LST) Q:$D(LST)>1 ; check ORWDX WRITE ORDERS first 10 N ORX,X0,X5,ORERR,I,SEQ,IEN,DGRP,FID,TXT,TYP 11 D GETLST^XPAR(.ORX,ANENT,"ORWOR WRITE ORDERS LIST","Q",.ORERR) Q:ORERR 12 S I=0 F S I=$O(ORX(I)) Q:'I D 13 . S SEQ=+ORX(I),IEN=$P(ORX(I),U,2),X0=$G(^ORD(101.41,+IEN,0)),X5=$G(^(5)) 14 . S DGRP=+$P(X0,U,5),FID=+$P(X5,U,5),TXT=$P(X5,U,4),TYP=$P(X0,U,4) 15 . S:'$L(TXT) TXT=$P(X0,U,2) 16 . I $P(X0,U,4)="M" S:'FID FID=1001 17 . S LST(SEQ)=IEN_";"_FID_";"_DGRP_";"_TYP_U_TXT 18 Q 19 WRLSTB(LST) ; return menu from which Write Orders list is built 20 N MNU,SEQ,IEN,ITM,TXT,FID,DGRP,X,TYP 21 S MNU=$$GET^XPAR(ANENT,"ORWDX WRITE ORDERS LIST",1,"I") Q:'MNU 22 S SEQ=0 F S SEQ=$O(^ORD(101.41,MNU,10,"B",SEQ)) Q:'SEQ D 23 . S IEN=0 F S IEN=$O(^ORD(101.41,MNU,10,"B",SEQ,IEN)) Q:'IEN D 24 . . S X=$G(^ORD(101.41,MNU,10,IEN,0)),ITM=+$P(X,U,2),TXT=$P(X,U,4) 25 . . S X=$G(^ORD(101.41,ITM,5)),FID=+$P(X,U,5) 26 . . S X=$G(^ORD(101.41,ITM,0)),TYP=$P(X,U,4),DGRP=+$P(X,U,5) 27 . . S:'$L(TXT) TXT=$P(X,U,2) 28 . . I TYP="M" S:'FID FID=1001 29 . . S LST(SEQ)=ITM_";"_FID_";"_DGRP_";"_TYP_U_TXT 30 Q 31 DELPI ; delete PI from ORDIALOG if PI = "" 32 ;Called from SAVE^ORWDX 33 N ORPI S ORPI=0 34 S ORPI=$O(^ORD(101.41,"B","OR GTX PATIENT INSTRUCTIONS",ORPI)) 35 Q:'$D(ORDIALOG(ORPI)) 36 I '$D(ORDIALOG(ORPI,1)) K ORDIALOG(ORPI),ORDIALOG("WP",ORPI) Q 37 N PINODE,PITX 38 S PITX="",PINODE=$G(ORDIALOG(ORPI,1)) 39 S PITX=$G(@PINODE@(1,0)) 40 S PITX=$TR(PITX," ","") 41 I '$L(PITX) K ORDIALOG(ORPI),ORDIALOG("WP",ORPI) Q 42 N ORSIG S ORSIG=+$O(^ORD(101.41,"B","OR GTX SIG",0)) 43 I $$STR^ORWDXR(ORSIG)[$$STR^ORWDXR(ORPI) S ORDIALOG(ORPI,"FORMAT")="@" 44 Q 45 FNDINFO(Y,ODIEN) ; 46 N ODI,CRTM,FRM,XX 47 S FRM="",CRTM=$$NOW^XLFDT 48 F S FRM=$O(^ORD(101.43,XRF,FRM)) Q:FRM="" D 49 . S ODI=0 F S ODI=$O(^ORD(101.43,XRF,FRM,ODI)) Q:'ODI D 50 .. S XX=^ORD(101.43,XRF,FRM,ODI) 51 .. I +$P(XX,U,3),$P(XX,U,3)<CRTM Q 52 .. I ODI=ODIEN D 53 ... S NM=NM+1 54 ... I 'XX S Y(NM)=ODIEN_U_$P(XX,U,2)_U_$P(XX,U,2) 55 ... E S Y(NM)=ODIEN_U_$P(XX,U,2)_$C(9)_"<"_$P(XX,U,4)_">"_U_$P(XX,U,4) 56 Q 57 DLGDEF(LST,DLG) ; Format mapping for a dlg 58 N I,IEN,ILST,X0,X2,XW S ILST=0 59 I $O(^ORD(101.41,"AB",DLG,0))>0 S DLG=$O(^ORD(101.41,"AB",DLG,0)) 60 E S DLG=$O(^ORD(101.41,"B",DLG,0)) 61 Q:'DLG 62 S I=0 F S I=$O(^ORD(101.41,DLG,10,I)) Q:I'>0 D 63 . S X0=$G(^ORD(101.41,DLG,10,I,0)),X2=$G(^(2)),IEN=+$P(X0,U,2) 64 . S ILST=ILST+1,LST(ILST)=U_IEN_U_$P(X2,U,1,7) 65 . I $P(X0,U,11) S $P(LST(ILST),U,11)=1 66 . S $P(LST(ILST),U)=$P($G(^ORD(101.41,IEN,1)),U,3) 67 . I $P($G(^ORD(101.41,IEN,0)),U)="OR GTX ADDITIVE" S $P(LST(ILST),U)="ADDITIVE" 68 . I $P($G(^ORD(101.41,IEN,0)),U)="OR GTX ADDL DIETS" S $P(LST(ILST),U)="ADDLDIETS" 69 . I $L($P(LST(ILST),U))=0 S $P(LST(ILST),U)="ID"_IEN 70 . I $D(^ORD(101.41,DLG,10,"DAD",IEN)) D 71 .. N SEQ,DA,CHILD S CHILD="" 72 .. S SEQ=0 F S SEQ=$O(^ORD(101.41,DLG,10,"DAD",IEN,SEQ)) Q:'SEQ D 73 ... S DA=0 F S DA=$O(^ORD(101.41,DLG,10,"DAD",IEN,SEQ,DA)) Q:'DA D 74 .... S CHILD=CHILD_+$P($G(^ORD(101.41,DLG,10,DA,0)),U,2)_"~" 75 .. S $P(LST(ILST),U,10)=CHILD 76 Q 77 ; 78 CHANGE(ORLST,ORCLST,DFN,ISIMO) ; 79 N CATCH,CHANGE,CNT,INP,INPDIEN,IVM,IVMDIEN,ORIEN,ORLOC,OR3,ORDG 80 N CIEN,DIAL,TDIAL,TDIEN,UDIEN,QORDDG,PACKIEN 81 S (INP,IVM,INPDIEN,IVMDIEN,UDIEN)=0 82 S (TDIAL,TDIEN)=0 83 S INP=$O(^ORD(101.41,"B","PSJ OR PAT OE","")) Q:INP'>0 84 S IVM=$O(^ORD(101.41,"B","PSJI OR PAT FLUID OE","")) Q:IVM'>0 85 S TDIAL=$O(^ORD(101.41,"B","OR GXTEXT WORD PROCESSING ORDER","")) Q:TDIAL'>0 86 S INPDIEN=$O(^ORD(100.98,"B","INPATIENT MEDICATIONS","")) Q:INPDIEN'>0 87 S IVMDIEN=$O(^ORD(100.98,"B","IV MEDICATIONS","")) Q:IVMDIEN'>0 88 S UDIEN=$O(^ORD(100.98,"B","UNIT DOSE MEDICATIONS","")) Q:UDIEN'>0 89 S TIEN=$O(^ORD(100.98,"B","NURSING","")) Q:TIEN'>0 90 S CIEN=$O(^ORD(100.98,"B","CLINIC ORDERS","")) Q:CIEN'>0 91 S CNT=0 F S CNT=$O(ORCLST(CNT)) Q:CNT'>0 D 92 .S CHANGE=0 93 .S ORIEN=$P($G(ORCLST(CNT)),U),ORIEN=$P(ORIEN,";") 94 .S ORDG=$P($G(^OR(100,ORIEN,0)),U,11) 95 .S ORLOC=$P($G(ORCLST(CNT)),U,2) 96 .S OR3=$G(^OR(100,ORIEN,3)) 97 .S DIAL=$P(OR3,U,4) 98 .;Remove Treating Speciality if the order location is the clinic 99 .I $P($G(^OR(100,ORIEN,0)),U,10)=(ORLOC_";SC("),$P($G(^SC(ORLOC,0)),U,3)="C" D Q 100 ..S $P(^OR(100,ORIEN,0),U,13)="" 101 .; 102 .;CHANGE PATIENT LOCATION AND PATIENT STATUS. 103 .S $P(^OR(100,ORIEN,0),U,10)=ORLOC_";SC(" 104 .S PACKIEN=$P(^OR(100,ORIEN,0),U,14) 105 .I $$GET1^DIQ(9.4,PACKIEN_",",1)'="PSO" S $P(^OR(100,ORIEN,0),U,12)="I" 106 .; 107 .;Check for IMO orders Nursing Dialog problem 108 .S CATCH=$P($G(^OR(100,ORIEN,0)),U,11) 109 .; 110 .S $P(^OR(100,ORIEN,0),U,11)=$S(DIAL=(IVM_";ORD(101.41,"):IVMDIEN,DIAL=(INP_";ORD(101.41,"):INPDIEN,DIAL=(TDIAL_";ORD(101.41,"):TIEN,1:CATCH) 111 .; 112 .;Check for Quick Order Dialog 113 .I CATCH=$P($G(^OR(100,ORIEN,0)),U,11),ISIMO=1 D 114 ..S QORDDG=$P($G(^ORD(101.41,+DIAL,0)),U,5) 115 ..I QORDDG=UDIEN!(QORDDG=INPDIEN) S $P(^OR(100,ORIEN,0),U,11)=INPDIEN,DIAL=(INP_";ORD(101.41,") Q 116 ..I QORDDG=IVMDIEN S $P(^OR(100,ORIEN,0),U,11)=IVMDIEN,DIAL=(IVM_";ORD(101.41,") Q 117 ..I QORDDG=TIEN S $P(^OR(100,ORIEN,0),U,11)=TIEN,DIAL=(TDIAL_";ORD(101.41,") Q 118 .; 119 .;Add treating spec if Inpatient order 120 .;I (ISIMO=1)&(DIAL=(IVM_";ORD(101.41,"))!(DIAL=(INP_";ORD(101.41,")) D 121 .;.S $P(^OR(100,ORIEN,0),U,13)=+$G(^DPT(DFN,.103)) 122 .I ISIMO=0 S $P(^OR(100,ORIEN,0),U,13)=+$G(^DPT(DFN,.103)) 123 Q 124 ; 125 STCHANGE(ORY,DFN,ORYARR) ; 126 N CNT,DONE,NODE,PHARMID,STR,STATUS 127 S ORY=0,DONE=0 128 I '$$PATCH^XPDUTL("PSS*1.0*93") Q 129 S CNT=0 F S CNT=$O(ORYARR(CNT)) Q:CNT'>0!(DONE>0) D 130 . S NODE=$G(ORYARR(CNT)) 131 . S PHARMID=$P(NODE,U),STATUS=$P(NODE,U,2) 132 . I $$UP^XLFSTR(STATUS)'=$$STATUS^PSSORUTE(DFN,PHARMID) S ORY=1,DONE=1 133 Q 134 ORDMATCH(ORY,DFN,ORYARR) ; 135 N ACTION,CNT,IEN,MATCH,ORDERID,STATUS 136 S CNT=0,MATCH=1 137 F S CNT=$O(ORYARR(CNT)) Q:CNT'>0!(MATCH=0) D 138 . S ORDERID=$P(ORYARR(CNT),U),STATUS=$P(ORYARR(CNT),U,2) 139 . I ORDERID=0,$G(ACTION)="" Q 140 . S IEN=$P(ORDERID,";"),ACTION=$P(ORDERID,";",2) 141 . I STATUS=$P($G(^OR(100,IEN,3)),U,3) Q 142 . I $P($G(^ORD(100.01,STATUS,0)),U)="DISCONTINUED/EDIT" Q 143 . ;S MATCH=0 144 . I $P($G(^OR(100,IEN,8,ACTION,0)),U,15)'=STATUS S MATCH=0 145 S ORY=MATCH 146 Q 147 ; 148 DCREN(ORY,ORYARR) ; 149 N ACT,CNT,CNT1,I,OR3,ORG,ORGID,ORID,TEXT,STATUS 150 S CNT1=0 151 S CNT=0 F S CNT=$O(ORYARR(CNT)) Q:CNT'>0 D 152 .S ORGID=ORYARR(CNT) 153 .S ORID=+ORGID,ACT=$P(ORGID,";",2),TEXT="" 154 .S OR3=$G(^OR(100,ORID,3)) 155 .;Make sure current order status is pending 156 .I $P($G(^ORD(100.01,$P(OR3,U,3),0)),U)'="PENDING" Q 157 .S ORG=$P($G(OR3),U,5) Q:ORG'>0 158 .;do not add original order if it is expired 159 .S STATUS=$P(^OR(100,ORG,3),U,3) 160 .I $P($G(^ORD(100.01,STATUS,0)),U)="EXPIRED" Q 161 .;Do not add original order if Stop date has pass 162 .I $P(^OR(100,ORG,0),U,9)'>$$NOW^XLFDT Q 163 .;make sure current order is a renewed order 164 .I $P(OR3,U,11)'=2 Q 165 .S ACT=+$P($G(^OR(100,ORG,3)),U,7) 166 .S CNT1=CNT1+1,ORY(CNT1)=ORGID_U_$P(OR3,U,5)_";"_ACT_U_TEXT 167 Q 168 DCORIG(ORY,ORIEN) ; 169 S $P(^OR(100,+ORIEN,6),U,9)=1 170 Q 171 UNDCORIG(ORY,ORYARR) ; 172 N CNT 173 S CNT=0 F S CNT=$O(ORYARR(CNT)) Q:CNT'>0 S $P(^OR(100,+ORYARR(CNT),6),U,9)=0 174 Q 175 PATWARD(ORY,DFN) ; 176 S ORY=0 177 I $G(^DPT(DFN,.1))'="" S ORY=1 178 Q 179 ISPEND(ORIFN) ;Is the order's status pending? 180 N ISPEND,PENDST,N3 S ISPEND=0 181 Q:'$D(^OR(100,+ORIFN,3)) 182 S PENDST=$O(^ORD(100.01,"B","PENDING",0)) 183 S N3=$G(^OR(100,+ORIFN,3)) 184 I $P(N3,U,3)=PENDST S ISPEND=1 185 Q ISPEND 1 ORWDX1 ; SLC/KCM/REV - Utilities for Order Dialogs ;10/14/05 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,187,195,215**;Dec 17, 1997 3 ; 4 WRLST(LST,LOC) ; Return list of dialogs for writing orders 5 ; .Y(n): DlgName^ListBox Text 6 WRLST1 N ANENT 7 S LOC=+$G(LOC)_";SC(" I 'LOC S LOC="" 8 S ANENT="ALL^"_LOC_$S($G(^VA(200,DUZ,5)):"^SRV.`"_+$G(^(5)),1:"") 9 D WRLSTB(.LST) Q:$D(LST)>1 ; check ORWDX WRITE ORDERS first 10 N ORX,X0,X5,ORERR,I,SEQ,IEN,DGRP,FID,TXT,TYP 11 D GETLST^XPAR(.ORX,ANENT,"ORWOR WRITE ORDERS LIST","Q",.ORERR) Q:ORERR 12 S I=0 F S I=$O(ORX(I)) Q:'I D 13 . S SEQ=+ORX(I),IEN=$P(ORX(I),U,2),X0=$G(^ORD(101.41,+IEN,0)),X5=$G(^(5)) 14 . S DGRP=+$P(X0,U,5),FID=+$P(X5,U,5),TXT=$P(X5,U,4),TYP=$P(X0,U,4) 15 . S:'$L(TXT) TXT=$P(X0,U,2) 16 . I $P(X0,U,4)="M" S:'FID FID=1001 17 . S LST(SEQ)=IEN_";"_FID_";"_DGRP_";"_TYP_U_TXT 18 Q 19 WRLSTB(LST) ; return menu from which Write Orders list is built 20 N MNU,SEQ,IEN,ITM,TXT,FID,DGRP,X,TYP 21 S MNU=$$GET^XPAR(ANENT,"ORWDX WRITE ORDERS LIST",1,"I") Q:'MNU 22 S SEQ=0 F S SEQ=$O(^ORD(101.41,MNU,10,"B",SEQ)) Q:'SEQ D 23 . S IEN=0 F S IEN=$O(^ORD(101.41,MNU,10,"B",SEQ,IEN)) Q:'IEN D 24 . . S X=$G(^ORD(101.41,MNU,10,IEN,0)),ITM=+$P(X,U,2),TXT=$P(X,U,4) 25 . . S X=$G(^ORD(101.41,ITM,5)),FID=+$P(X,U,5) 26 . . S X=$G(^ORD(101.41,ITM,0)),TYP=$P(X,U,4),DGRP=+$P(X,U,5) 27 . . S:'$L(TXT) TXT=$P(X,U,2) 28 . . I TYP="M" S:'FID FID=1001 29 . . S LST(SEQ)=ITM_";"_FID_";"_DGRP_";"_TYP_U_TXT 30 Q 31 DELPI ; delete PI from ORDIALOG if PI = "" 32 ;Called from SAVE^ORWDX 33 N ORPI S ORPI=0 34 S ORPI=$O(^ORD(101.41,"B","OR GTX PATIENT INSTRUCTIONS",ORPI)) 35 Q:'$D(ORDIALOG(ORPI)) 36 I '$D(ORDIALOG(ORPI,1)) K ORDIALOG(ORPI),ORDIALOG("WP",ORPI) Q 37 N PINODE,PITX 38 S PITX="",PINODE=$G(ORDIALOG(ORPI,1)) 39 S PITX=$G(@PINODE@(1,0)) 40 S PITX=$TR(PITX," ","") 41 I '$L(PITX) K ORDIALOG(ORPI),ORDIALOG("WP",ORPI) 42 Q 43 FNDINFO(Y,ODIEN) ; 44 N ODI,CRTM,FRM,XX 45 S FRM="",CRTM=$$NOW^XLFDT 46 F S FRM=$O(^ORD(101.43,XRF,FRM)) Q:FRM="" D 47 . S ODI=0 F S ODI=$O(^ORD(101.43,XRF,FRM,ODI)) Q:'ODI D 48 .. S XX=^ORD(101.43,XRF,FRM,ODI) 49 .. I +$P(XX,U,3),$P(XX,U,3)<CRTM Q 50 .. I ODI=ODIEN D 51 ... S NM=NM+1 52 ... I 'XX S Y(NM)=ODIEN_U_$P(XX,U,2)_U_$P(XX,U,2) 53 ... E S Y(NM)=ODIEN_U_$P(XX,U,2)_$C(9)_"<"_$P(XX,U,4)_">"_U_$P(XX,U,4) 54 Q 55 DLGDEF(LST,DLG) ; Format mapping for a dlg 56 N I,IEN,ILST,X0,X2,XW S ILST=0 57 I $O(^ORD(101.41,"AB",DLG,0))>0 S DLG=$O(^ORD(101.41,"AB",DLG,0)) 58 E S DLG=$O(^ORD(101.41,"B",DLG,0)) 59 Q:'DLG 60 S I=0 F S I=$O(^ORD(101.41,DLG,10,I)) Q:I'>0 D 61 . S X0=$G(^ORD(101.41,DLG,10,I,0)),X2=$G(^(2)),IEN=+$P(X0,U,2) 62 . S ILST=ILST+1,LST(ILST)=U_IEN_U_$P(X2,U,1,7) 63 . I $P(X0,U,11) S $P(LST(ILST),U,11)=1 64 . S $P(LST(ILST),U)=$P($G(^ORD(101.41,IEN,1)),U,3) 65 . I $P($G(^ORD(101.41,IEN,0)),U)="OR GTX ADDITIVE" S $P(LST(ILST),U)="ADDITIVE" 66 . I $P($G(^ORD(101.41,IEN,0)),U)="OR GTX ADDL DIETS" S $P(LST(ILST),U)="ADDLDIETS" 67 . I $L($P(LST(ILST),U))=0 S $P(LST(ILST),U)="ID"_IEN 68 . I $D(^ORD(101.41,DLG,10,"DAD",IEN)) D 69 .. N SEQ,DA,CHILD S CHILD="" 70 .. S SEQ=0 F S SEQ=$O(^ORD(101.41,DLG,10,"DAD",IEN,SEQ)) Q:'SEQ D 71 ... S DA=0 F S DA=$O(^ORD(101.41,DLG,10,"DAD",IEN,SEQ,DA)) Q:'DA D 72 .... S CHILD=CHILD_+$P($G(^ORD(101.41,DLG,10,DA,0)),U,2)_"~" 73 .. S $P(LST(ILST),U,10)=CHILD 74 Q 75 ; 76 CHANGE(ORLST,ORCLST,DFN) ; 77 N CATCH,CNT,INP,INPDIEN,IVM,IVMDIEN,ORIEN,ORLOC,OR3,ORDG 78 N CIEN,DIAL,TDIAL,TDIEN,UDIEN,QORDDG 79 S (INP,IVM,INPDIEN,IVMDIEN,UDIEN)=0 80 S (TDIAL,TDIEN)=0 81 S INP=$O(^ORD(101.41,"B","PSJ OR PAT OE","")) Q:INP'>0 82 S IVM=$O(^ORD(101.41,"B","PSJI OR PAT FLUID OE","")) Q:IVM'>0 83 S TDIAL=$O(^ORD(101.41,"B","OR GXTEXT WORD PROCESSING ORDE","")) Q:TDIAL'>0 84 S INPDIEN=$O(^ORD(100.98,"B","INPATIENT MEDICATIONS","")) Q:INPDIEN'>0 85 S IVMDIEN=$O(^ORD(100.98,"B","IV MEDICATIONS","")) Q:IVMDIEN'>0 86 S UDIEN=$O(^ORD(100.98,"B","UNIT DOSE MEDICATIONS","")) Q:UDIEN'>0 87 S TIEN=$O(^ORD(100.98,"B","NURSING","")) Q:TIEN'>0 88 S CIEN=$O(^ORD(100.98,"B","CLINIC ORDERS","")) Q:CIEN'>0 89 S CNT=0 F S CNT=$O(ORCLST(CNT)) Q:CNT'>0 D 90 .S CHANGE=0 91 .S ORIEN=$P($G(ORCLST(CNT)),U),ORIEN=$P(ORIEN,";") 92 .S ORDG=$P($G(^OR(100,ORIEN,0)),U,11) 93 .I ORDG'=INPDIEN,ORDG'=IVMDIEN,ORDG'=UDIEN,ORDG'=TIEN,ORDG'=CIEN Q 94 .S ORLOC=$P($G(ORCLST(CNT)),U,2) 95 .S OR3=$G(^OR(100,ORIEN,3)) 96 .S DIAL=$P(OR3,U,4) 97 . 98 .; 99 .I $P($G(^OR(100,ORIEN,0)),U,10)=(ORLOC_";SC(") D Q 100 ..;Remove treating spec. if IMO order 26.42 101 ..I $P($G(^OR(100,ORIEN,0)),U,11)=CIEN S $P(^OR(100,ORIEN,0),U,13)="" 102 .; 103 .;CHANGE PATIENT LOCATION AND PATIENT STATUS. 104 .S $P(^OR(100,ORIEN,0),U,10)=ORLOC_";SC(" 105 .S $P(^OR(100,ORIEN,0),U,12)="I" 106 .; 107 .;Check for IMO orders Nursing Dialog problem 108 .S CATCH=$P($G(^OR(100,ORIEN,0)),U,11) 109 .; 110 .S $P(^OR(100,ORIEN,0),U,11)=$S(DIAL=(IVM_";ORD(101.41,"):IVMDIEN,DIAL=(INP_";ORD(101.41,"):INPDIEN,DIAL=(TDIAL_";ORD(101.41,"):TIEN,1:CATCH) 111 .; 112 .;Check for Quick Order Dialog 113 .I CATCH=$P($G(^OR(100,ORIEN,0)),U,11) D 114 ..S QORDDG=$P($G(^ORD(101.41,+DIAL,0)),U,5) 115 ..I QORDDG=UDIEN!(QORDDG=INPDIEN) S $P(^OR(100,ORIEN,0),U,11)=INPDIEN,DIAL=(INP_";ORD(101.41,") Q 116 ..I QORDDG=IVMDIEN S $P(^OR(100,ORIEN,0),U,11)=IVMDIEN,DIAL=(IVM_";ORD(101.41,") Q 117 ..I QORDDG=TIEN S $P(^OR(100,ORIEN,0),U,11)=TIEN,DIAL=(TDIAL_";ORD(101.41,") Q 118 .; 119 .;Add treating spec if Inpatient order 120 .I (DIAL=(IVM_";ORD(101.41,"))!(DIAL=(INP_";ORD(101.41,")) D 121 ..S $P(^OR(100,ORIEN,0),U,13)=+$G(^DPT(DFN,.103)) 122 Q 123 ; 124 STCHANGE(ORY,DFN,ORYARR) ; 125 N CNT,DONE,NODE,PHARMID,STR,STATUS 126 S ORY=0,DONE=0 127 I '$$PATCH^XPDUTL("PSS*1.0*93") Q 128 S CNT=0 F S CNT=$O(ORYARR(CNT)) Q:CNT'>0!(DONE>0) D 129 . S NODE=$G(ORYARR(CNT)) 130 . S PHARMID=$P(NODE,U),STATUS=$P(NODE,U,2) 131 . I $$UP^XLFSTR(STATUS)'=$$STATUS^PSSORUTE(DFN,PHARMID) S ORY=1,DONE=1 132 Q 133 DCREN(ORY,ORYARR) ; 134 N ACT,CNT,CNT1,I,OR3,ORG,ORGID,ORID,TEXT,STATUS 135 S CNT1=0 136 S CNT=0 F S CNT=$O(ORYARR(CNT)) Q:CNT'>0 D 137 .S ORGID=ORYARR(CNT) 138 .S ORID=+ORGID,ACT=$P(ORGID,";",2),TEXT="" 139 .S OR3=$G(^OR(100,ORID,3)) 140 .;Make sure current order status is pending 141 .I $P($G(^ORD(100.01,$P(OR3,U,3),0)),U)'="PENDING" Q 142 .S ORG=$P($G(OR3),U,5) Q:ORG'>0 143 .;do not add original order if it is expired 144 .S STATUS=$P(^OR(100,ORG,3),U,3) 145 .I $P($G(^ORD(100.01,STATUS,0)),U)="EXPIRED" Q 146 .;make sure current order is a renewed order 147 .I $P(OR3,U,11)'=2 Q 148 .S ACT=+$P($G(^OR(100,ORG,3)),U,7) 149 .S CNT1=CNT1+1,ORY(CNT1)=ORGID_U_$P(OR3,U,5)_";"_ACT_U_TEXT 150 Q 151 PATWARD(ORY,DFN) ; 152 S ORY=0 153 I $G(^DPT(DFN,.1))'="" S ORY=1 154 Q 155 ISPEND(ORIFN) ;Is the order's status pending? 156 N ISPEND,PENDST,N3 S ISPEND=0 157 Q:'$D(^OR(100,+ORIFN,3)) 158 S PENDST=$O(^ORD(100.01,"B","PENDING",0)) 159 S N3=$G(^OR(100,+ORIFN,3)) 160 I $P(N3,U,3)=PENDST S ISPEND=1 161 Q ISPEND
Note:
See TracChangeset
for help on using the changeset viewer.
