- 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/ORCSAVE2.m
r613 r623 1 ORCSAVE2 ;SLC/MKB-Utilities to update an order ; 4/8/08 12:04pm 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,27,56,70,94,116,190,157,215,265,243**;Dec 17, 1997;Build 242 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 STATUS(IFN,ST) ; -- Update status of order 6 Q:'$G(IFN) Q:'$D(^OR(100,+IFN,0)) Q:$P($G(^(3)),U,3)=$G(ST) ;no change 7 Q:'$G(ST) Q:'$D(^ORD(100.01,+ST,0)) 8 N NODE0,NODE3,ORNOW,DA,XACT,PROV,ORVP 9 S NODE3=$G(^OR(100,+IFN,3)),ORVP=$P($G(^(0)),U,2),ORNOW=$$NOW^XLFDT 10 S $P(NODE3,U)=ORNOW,$P(NODE3,U,3)=ST,^OR(100,+IFN,3)=NODE3 11 I (ST<3)!(ST=12)!(ST=13),$G(ORDCNTRL)'="ZC" D DATES(+IFN,,+$E(ORNOW,1,12)) 12 I "^1^2^7^12^13^15^"[(U_ST_U) D CANCEL^ORCSEND(+IFN),UNOTIF^ORCSIGN 13 I $P(NODE3,U,9) D CKPARENT($P(NODE3,U,9)) ; ck siblings to update parent 14 D SETALL^ORDD100(+IFN) 15 Q 16 ; 17 CKPARENT(ORIFN) ; -- Update status of parent order, if appropriate 18 N ORSTS,ALLRELSD,ALLDONE,DC,COMP,CH,CHSTS,ACTIVE,LAPS 19 Q:'$D(^OR(100,ORIFN,0)) S ORSTS=$P($G(^(3)),U,3) 20 I (ORSTS=11)!(ORSTS=10) S ALLRELSD=1 D Q ;Parent unrel'd - ck children 21 . F CH=0:0 S CH=$O(^OR(100,ORIFN,2,CH)) Q:CH'>0 D Q:'ALLRELSD 22 . . I '$D(^OR(100,CH)) K ^OR(100,ORIFN,2,CH) Q 23 . . S CHSTS=$P($G(^OR(100,CH,3)),U,3) S:CHSTS=11 ALLRELSD=0 24 . I ALLRELSD D STATUS(ORIFN,5) ; update Parent order to pending 25 S ALLDONE=1,(DC,COMP,LAPS,ACTIVE)=0 26 F CH=0:0 S CH=$O(^OR(100,ORIFN,2,CH)) Q:CH'>0 D Q:'ALLDONE 27 . I '$D(^OR(100,CH)) K ^OR(100,ORIFN,2,CH) Q 28 . S CHSTS=$P($G(^OR(100,CH,3)),U,3) I CHSTS=14 S LAPS=1 Q 29 . I "^1^12^13^"[(U_CHSTS_U) S DC=1 Q 30 . I "^2^7^"[(U_CHSTS_U) S COMP=1 Q 31 . S ALLDONE=0 S:CHSTS=6 ACTIVE=1 32 I ALLDONE S ORSTS=$S(COMP:2,DC:1,LAPS:14,1:"") D:ORSTS STATUS(ORIFN,ORSTS) Q 33 I ACTIVE,ORSTS'=6 D STATUS(ORIFN,6) ;at least child active 34 Q 35 ; 36 RELEASE(ORDER,ACTION,WHEN,WHO,NATURE) ; -- Mark order as released to service 37 S:'$G(ACTION) ACTION=1 S:'$G(WHEN) WHEN=+$E($$NOW^XLFDT,1,12) S:'$G(WHO) WHO=DUZ 38 Q:'$G(ORDER) N OR0 S OR0=$G(^OR(100,ORDER,8,ACTION,0)) 39 S:$L($G(NATURE)) $P(OR0,U,12)=$S(NATURE:NATURE,1:+$O(^ORD(100.02,"C",NATURE,0))) 40 S:($P(OR0,U,15)=10)!($P(OR0,U,15)=11) $P(OR0,U,15)="" 41 ;S $P(OR0,U,16,17)=WHEN_U_WHO,^OR(100,"AR",ORVP,9999999-WHEN,ORDER,ACTION)="" 42 S $P(OR0,U,16,17)=WHEN_U_WHO 43 S ^OR(100,ORDER,8,ACTION,0)=OR0 44 I $P(OR0,U,2)="NW",'$P(^OR(100,ORDER,0),U,8) D STARTDT(ORDER) 45 ;Set the "AR" index. 46 D RS^ORDD100(ORDER,ACTION,ORVP,WHEN) 47 Q 48 ; 49 STARTDT(DA) ; -- resolve Start and Stop dates from Responses 50 N X,Y,%DT,ORDG,ORT,ORLAB 51 S ORDG=$P($G(^ORD(100.98,+$P(^OR(100,DA,0),U,11),0)),U,3) 52 S ORLAB="^LAB^CH^HEMA^MI^AP^AU^EM^SP^CY^BB^"[(U_ORDG_U),ORT="" 53 S:ORDG="E/L T" ORT=$$VALUE(DA,"TIME") S:ORDG="MEAL" ORT=$$MEALTIME^ORCDFHO(DA) 54 STRT S X=$$VALUE(DA,"START") I '$L(X) D WS^ORDD100 Q S:$L(ORT) X=X_"@"_ORT 55 D AM:X="AM",NEXT:X="NEXT",ADMIN("NEXT"):X="NEXTA",ADMIN("CLOSEST"):X="CLOSEST" 56 S %DT="T" D ^%DT Q:Y'>0 S:$E($P(Y,".",2),1,2)=24 Y=$P(Y,".")_".2359" 57 S $P(^OR(100,DA,0),U,8)=Y D SS^ORDD100,WS^ORDD100,OI1^ORDD100A(DA) 58 STOP I ORLAB S X=$$VALUE(DA,"DAYS") Q:X'>1 S X=$$FMADD^XLFDT(Y,(X-1)) 59 I 'ORLAB S X=$$VALUE(DA,"STOP") Q:'$L(X) S:$L(ORT) X=X_"@"_ORT 60 S %DT="T" D ^%DT Q:Y'>0 S:$E($P(Y,".",2),1,2)=24 Y=$P(Y,".")_".2359" 61 S $P(^OR(100,DA,0),U,9)=Y D ES^ORDD100A 62 Q 63 ; 64 NEXT ; -- Resolve next lab collection to FM date/time 65 N ORTIME,ORDAY,NOW,NEXT,ENT 66 ;is referenced by DBIA #964 67 S ENT=$S($P($G(^SC(+$G(ORL),0)),U,4):+$P(^(0),U,4),1:+$G(DUZ(2)))_";DIC(4," S:ENT'>0 ENT="ALL" 68 D GETLST^XPAR(.ORTIME,ENT,"LR PHLEBOTOMY COLLECTION","N") 69 S NOW=$P($H,",",2),ORDAY=$S($O(ORTIME(NOW)):"T",1:"T+1") 70 S ORDAY=$$NEXTCOLL^ORCDLR1(ORDAY) S:ORDAY["+" NOW=0 71 S NEXT=$O(ORTIME(NOW)),X=ORDAY_"@"_$P($G(ORTIME(+NEXT)),U) 72 Q 73 ; 74 AM ; -- Resolve AM lab collection to FM date/time 75 N ORTIME,ORDAY,AM,NOW,ENT 76 ;is referenced by DBIA #964 77 S ENT=$S($P($G(^SC(+$G(ORL),0)),U,4):+$P(^(0),U,4),1:+$G(DUZ(2)))_";DIC(4," S:ENT'>0 ENT="ALL" 78 D GETLST^XPAR(.ORTIME,ENT,"LR PHLEBOTOMY COLLECTION","N") 79 S AM=$O(ORTIME(0)),NOW=$P($H,",",2) 80 S ORDAY=$S(AM=$O(ORTIME(NOW)):"T",1:"T+1") 81 S X=$$NEXTCOLL^ORCDLR1(ORDAY)_"@"_$P($G(ORTIME(+AM)),U) 82 Q 83 ; 84 ADMIN(START) ; -- Resolve next/closest administration times to FM date/time 85 N PAT,SCH,OI,LOC,Y,I 86 I $G(DA) D ;get data from order DA 87 . S PAT=+$P($G(^OR(100,DA,0)),U,2),LOC="" 88 . S I=+$O(^OR(100,DA,4.5,"ID","INSTR",0)),I=+$P($G(^OR(100,DA,4.5,I,0)),U,3) ;first 89 . S SCH=$$VALUE(DA,"SCHEDULE",I),OI=$$VALUE(DA,"ORDERABLE") 90 I '$G(DA) D ;or look in ORDIALOG() instead 91 . S I=+$O(ORDIALOG($$PTR^ORCD("OR GTX INSTRUCTIONS"),0)) 92 . S PAT=$G(ORVP),SCH=$G(ORDIALOG($$PTR^ORCD("OR GTX SCHEDULE"),I)) 93 . S OI=$G(ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1)),LOC="" 94 S OI=+$P($G(^ORD(101.43,+OI,0)),U,2) ;PSOI 95 ;is referenced by DBIA #3167 96 S Y=$$RESOLVE^PSJORPOE(PAT,SCH,OI,START,LOC),X=$P(Y,U,2) 97 Q 98 ; 99 SIGN(DA,WHO,WHEN,HOW,WHAT) ; -- affix ES to order 100 Q:'$G(DA) S:'$G(WHAT) WHAT=1 101 N X S X=$G(^OR(100,DA,8,WHAT,0)) D S2^ORDD100(DA,WHAT) ; kill AS xref 102 S $P(X,U,4,7)=$G(HOW)_U_$G(WHO)_U_$E($G(WHEN),1,12)_U_$S(HOW=0:DUZ,1:"") 103 ; S:$G(WHO) $P(X,U,3)=WHO ; reset provider to signer 104 S ^OR(100,DA,8,WHAT,0)=X 105 D:$G(HOW)=2 S1^ORDD100(DA,WHAT) ; reset AS xref 106 Q 107 ; 108 SIGSTS(IFN,ACT) ; -- Set SigSts for backdoor orders [Called from ^ORM* rtns] 109 ; Expects ORNATR, ORVP, ORNP to be defined 110 Q:'$G(IFN) Q:'$G(ACT) N X,OR0 S OR0=+$P($G(^OR(100,+IFN,8,ACT,0)),U) 111 S X=$S($$SIGNREQD^ORCACT1(+IFN):$$SIGSTS^ORX1(ORNATR),1:3) 112 K ^OR(100,"AS",ORVP,9999999-OR0,+IFN,ACT) 113 S $P(^OR(100,+IFN,8,ACT,0),U,4)=X 114 I X=2 S ^OR(100,"AS",ORVP,9999999-OR0,+IFN,ACT)="" D NOTIF^ORCSIGN 115 Q 116 ; 117 UNVEIL(IFN) ; -- unveil new order 118 S $P(^OR(100,IFN,3),U,8)="" 119 Q 120 ; 121 DELETE(ORDER) ; -- delete order [action] 122 N DIK,DA,DAD 123 I $P(ORDER,";",2)>1 S DA=+$P(ORDER,";",2),DA(1)=+ORDER,DIK="^OR(100,"_DA(1)_",8," D:DA ^DIK Q 124 S DAD=+$P($G(^OR(100,+ORDER,3)),U,9) I DAD S DIK="^OR(100,"_DAD_",2,",DA(1)=DAD,DA=+ORDER D ^DIK ; remove link to child from parent 125 K DA S DA=+ORDER,DIK="^OR(100," D ^DIK ;remove order, text 126 Q 127 ; 128 VERIFY(IFN,DA,TYPE,WHO,WHEN) ; -- order verified 129 Q:'$G(IFN) Q:'$G(DA) Q:"^N^C^R^"'[(U_$G(TYPE)_U) 130 N FLD S FLD=$S(TYPE="N":8,TYPE="C":10,1:18) 131 S:'$G(WHO) WHO=DUZ S:'$G(WHEN) WHEN=+$E($$NOW^XLFDT,1,12) 132 S $P(^OR(100,IFN,8,DA,0),U,FLD,FLD+1)=WHO_U_WHEN 133 D:$L($T(VER^EDPFMON)) VER^EDPFMON(IFN) 134 Q 135 ; 136 COMP(IFN,WHO,WHEN) ; -- order completed 137 Q:'$G(IFN) S:'$G(WHO) WHO=DUZ S:'$G(WHEN) WHEN=+$E($$NOW^XLFDT,1,12) 138 D DATES(+IFN,,WHEN),STATUS(+IFN,2) 139 S $P(^OR(100,+IFN,6),U,6,7)=WHEN_U_WHO 140 D:$L($T(COMP^EDPFMON)) COMP^EDPFMON(IFN) 141 Q 142 ; 143 DATES(DA,START,STOP) ; -- Update start/stop dates for order DA 144 Q:'$G(DA) I $G(START) D 145 . Q:START=$P(^OR(100,DA,0),U,8) 146 . D SK^ORDD100,WK^ORDD100,OI2^ORDD100A(DA) 147 . S $P(^OR(100,DA,0),U,8)=START 148 . D SS^ORDD100,WS^ORDD100,OI1^ORDD100A(DA) 149 I $G(STOP) D 150 . ;Q:STOP=$P(^OR(100,DA,0),U,9) ;ck xref anyway 151 . D EK^ORDD100A S $P(^OR(100,DA,0),U,9)=STOP D ES^ORDD100A 152 Q 153 ; 154 OC ; -- Save order checks in ORCHECK() in ^OR(100,+ORIFN,9) 155 Q:'$G(ORIFN) Q:'$D(^OR(100,+ORIFN,0)) K ^OR(100,+ORIFN,9) 156 N NOW,CNT,CDL,I,OC,OVERIDE S NOW=+$E($$NOW^XLFDT,1,12),CNT=0 157 S CDL=0 F S CDL=$O(ORCHECK(+ORIFN,CDL)) Q:CDL'>0 D 158 . S I=0 F S I=$O(ORCHECK(+ORIFN,CDL,I)) Q:I'>0 D 159 . . S OC=ORCHECK(+ORIFN,CDL,I) Q:'OC 160 . . S OVERIDE=$S($G(MODE)="NOTIF":$G(ORCHECK("OK"))_U,CDL=1:$G(ORCHECK("OK"))_U_DUZ,1:U_DUZ)_U_NOW 161 . . S CNT=CNT+1,^OR(100,+ORIFN,9,"B",+OC,CNT)="" 162 . . S ^OR(100,+ORIFN,9,CNT,0)=$P(OC,U,1,2)_U_U_OVERIDE,^(1)=$E($P(OC,U,3),1,245) 163 S:CNT ^OR(100,+ORIFN,9,0)="^100.09PA^"_CNT_U_CNT 164 Q 165 ; 166 VALUE(IFN,ID,INST) ; -- Returns value of prompt by identifier ID 167 I '$G(IFN)!('$D(^OR(100,+$G(IFN),0)))!($G(ID)="") Q "" 168 N I,Y S I=0,Y="" S:'$G(INST) INST=1 169 F S I=$O(^OR(100,IFN,4.5,"ID",ID,I)) Q:I'>0 I $P($G(^OR(100,IFN,4.5,+I,0)),U,3)=INST S Y=$G(^(1)) Q 170 Q Y 171 ; 172 SC(ORX,ORIFN) ; -- save responses to SC questions 173 Q:'$G(ORIFN) Q:'$D(^OR(100,+ORIFN,0)) ;invalid order number 174 N OR5,I,P S OR5=$G(^OR(100,+ORIFN,5)),P=0 175 F I="SC","MST","AO","IR","EC","HNC","CV","SHD" S P=P+1 S:$D(ORX(I)) $P(OR5,U,P)=ORX(I) 176 S ^OR(100,+ORIFN,5)=OR5 177 Q 178 ; 179 CANCEL(ORDER) ; -- cancel order [action] 180 N ORA,DIE,DA,DR,ORX 181 S ORDER=$G(ORDER),ORA=+$P(ORDER,";",2) Q:'ORA!('ORDER) 182 I $D(^OR(100,+ORDER,8,ORA)) D 183 .S ORX="Unsigned/unreleased order cancelled by provider" 184 .S DIE="^OR(100,"_+ORDER_",8,",DA=ORA,DA(1)=+ORDER 185 .S DR="4////5;15////13;1////^S X=ORX" D ^DIE 186 I ORA=1 D 187 .K DA S DIE="^OR(100,",DA=+ORDER,DR="5////13" D ^DIE 188 Q 189 ; 190 LAPSE(ORDER) ; -- lapse order [action] 191 N ORA S ORA=+$P(ORDER,";",2) 192 Q:'$D(^OR(100,+ORDER,0)) Q:'ORA!('ORDER) 193 I $D(^OR(100,+ORDER,8,ORA)) D 194 .N DIE,DA,DR 195 .S DIE="^OR(100,"_+ORDER_",8,",DA=ORA,DA(1)=+ORDER 196 .S DR="4////5;15////14" D ^DIE 197 I ORA=1 D 198 .N DIE,DA,DR 199 .S DIE="^OR(100,",DA=+ORDER,DR="5////14" 200 .D ^DIE,ALPS(DA,ORA) 201 Q 202 ALPS(DA,ORACT,TYPE) ;set the lapse index ^OR(100,"ALPS") 203 N ORVP,X,OR0,ORLOG 204 S OR0=$G(^OR(100,DA,8,ORACT,0)) 205 S ORLOG=$P(OR0,U),ORVP=$P($G(^OR(100,DA,0)),U,2) 206 I ORVP,ORLOG S ^OR(100,"ALPS",ORVP,9999999-ORLOG,DA,ORACT)=$G(TYPE) 207 S ^OR(100,DA,10)=$$NOW^XLFDT 208 Q 209 ; 210 RESP(IFN,PRMT,VAL,INST) ; -- update a single Response VALue 211 S IFN=+$G(IFN),VAL=$G(VAL),PRMT=+$O(^ORD(101.41,"AB",PRMT,0)) 212 N ID,DA,DIK S:'$G(INST) INST=1 213 S ID=$P($G(^ORD(101.41,PRMT,1)),U,3) Q:'$L(ID) 214 S DA=0 F S DA=$O(^OR(100,IFN,4.5,"ID",ID,DA)) Q:DA<1 Q:$P($G(^OR(100,IFN,4.5,DA,0)),U,3)=INST 215 I 'DA D:$L(VAL) Q ;add 216 . N DO,DIC,DLG,X 217 . S DIC="^OR(100,"_IFN_",4.5,",DA(1)=IFN,DIC(0)="FL" 218 . S DIC("DR")=".02///"_PRMT_";.03///"_INST_";.04///"_ID 219 . S DLG=+$P($G(^OR(100,IFN,0)),U,5) 220 . S X=+$O(^ORD(101.41,DLG,10,"D",PRMT,0)) 221 . D FILE^DICN S:Y ^OR(100,IFN,4.5,+Y,1)=VAL 222 I $L(VAL) S ^OR(100,IFN,4.5,DA,1)=VAL Q ;change 223 S DIK="^OR(100,"_IFN_",4.5,",DA(1)=IFN D ^DIK ;delete 224 Q 1 ORCSAVE2 ;SLC/MKB-Utilities to update an order ;04:19 PM 06/16/2004 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,27,56,70,94,116,190,157,215,265**;Dec 17, 1997;Build 17 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 STATUS(IFN,ST) ; -- Update status of order 6 Q:'$G(IFN) Q:'$D(^OR(100,+IFN,0)) Q:$P($G(^(3)),U,3)=$G(ST) ;no change 7 Q:'$G(ST) Q:'$D(^ORD(100.01,+ST,0)) 8 N NODE0,NODE3,ORNOW,DA,XACT,PROV,ORVP 9 S NODE3=$G(^OR(100,+IFN,3)),ORVP=$P($G(^(0)),U,2),ORNOW=$$NOW^XLFDT 10 S $P(NODE3,U)=ORNOW,$P(NODE3,U,3)=ST,^OR(100,+IFN,3)=NODE3 11 I (ST<3)!(ST=12)!(ST=13),$G(ORDCNTRL)'="ZC" D DATES(+IFN,,+$E(ORNOW,1,12)) 12 I "^1^2^7^12^13^15^"[(U_ST_U) D CANCEL^ORCSEND(+IFN),UNOTIF^ORCSIGN 13 I $P(NODE3,U,9) D CKPARENT($P(NODE3,U,9)) ; ck siblings to update parent 14 D SETALL^ORDD100(+IFN) 15 Q 16 ; 17 CKPARENT(ORIFN) ; -- Update status of parent order, if appropriate 18 N ORSTS,ALLRELSD,ALLDONE,DC,COMP,CH,CHSTS,ACTIVE,LAPS 19 Q:'$D(^OR(100,ORIFN,0)) S ORSTS=$P($G(^(3)),U,3) 20 I (ORSTS=11)!(ORSTS=10) S ALLRELSD=1 D Q ;Parent unrel'd - ck children 21 . F CH=0:0 S CH=$O(^OR(100,ORIFN,2,CH)) Q:CH'>0 D Q:'ALLRELSD 22 . . I '$D(^OR(100,CH)) K ^OR(100,ORIFN,2,CH) Q 23 . . S CHSTS=$P($G(^OR(100,CH,3)),U,3) S:CHSTS=11 ALLRELSD=0 24 . I ALLRELSD D STATUS(ORIFN,5) ; update Parent order to pending 25 S ALLDONE=1,(DC,COMP,LAPS,ACTIVE)=0 26 F CH=0:0 S CH=$O(^OR(100,ORIFN,2,CH)) Q:CH'>0 D Q:'ALLDONE 27 . I '$D(^OR(100,CH)) K ^OR(100,ORIFN,2,CH) Q 28 . S CHSTS=$P($G(^OR(100,CH,3)),U,3) I CHSTS=14 S LAPS=1 Q 29 . I "^1^12^13^"[(U_CHSTS_U) S DC=1 Q 30 . I "^2^7^"[(U_CHSTS_U) S COMP=1 Q 31 . S ALLDONE=0 S:CHSTS=6 ACTIVE=1 32 I ALLDONE S ORSTS=$S(COMP:2,DC:1,LAPS:14,1:"") D:ORSTS STATUS(ORIFN,ORSTS) Q 33 I ACTIVE,ORSTS'=6 D STATUS(ORIFN,6) ;at least child active 34 Q 35 ; 36 RELEASE(ORDER,ACTION,WHEN,WHO,NATURE) ; -- Mark order as released to service 37 S:'$G(ACTION) ACTION=1 S:'$G(WHEN) WHEN=+$E($$NOW^XLFDT,1,12) S:'$G(WHO) WHO=DUZ 38 Q:'$G(ORDER) N OR0 S OR0=$G(^OR(100,ORDER,8,ACTION,0)) 39 S:$L($G(NATURE)) $P(OR0,U,12)=$S(NATURE:NATURE,1:+$O(^ORD(100.02,"C",NATURE,0))) 40 S:($P(OR0,U,15)=10)!($P(OR0,U,15)=11) $P(OR0,U,15)="" 41 ;S $P(OR0,U,16,17)=WHEN_U_WHO,^OR(100,"AR",ORVP,9999999-WHEN,ORDER,ACTION)="" 42 S $P(OR0,U,16,17)=WHEN_U_WHO 43 S ^OR(100,ORDER,8,ACTION,0)=OR0 44 I $P(OR0,U,2)="NW",'$P(^OR(100,ORDER,0),U,8) D STARTDT(ORDER) 45 ;Set the "AR" index. 46 D RS^ORDD100(ORDER,ACTION,ORVP,WHEN) 47 Q 48 ; 49 STARTDT(DA) ; -- resolve Start and Stop dates from Responses 50 N X,Y,%DT,ORDG,ORT,ORLAB 51 S ORDG=$P($G(^ORD(100.98,+$P(^OR(100,DA,0),U,11),0)),U,3) 52 S ORLAB="^LAB^CH^HEMA^MI^AP^AU^EM^SP^CY^BB^"[(U_ORDG_U),ORT="" 53 S:ORDG="E/L T" ORT=$$VALUE(DA,"TIME") S:ORDG="MEAL" ORT=$$MEALTIME^ORCDFHO(DA) 54 STRT S X=$$VALUE(DA,"START") I '$L(X) D WS^ORDD100 Q S:$L(ORT) X=X_"@"_ORT 55 D AM:X="AM",NEXT:X="NEXT",ADMIN("NEXT"):X="NEXTA",ADMIN("CLOSEST"):X="CLOSEST" 56 S %DT="T" D ^%DT Q:Y'>0 S:$E($P(Y,".",2),1,2)=24 Y=$P(Y,".")_".2359" 57 S $P(^OR(100,DA,0),U,8)=Y D SS^ORDD100,WS^ORDD100,OI1^ORDD100A(DA) 58 STOP I ORLAB S X=$$VALUE(DA,"DAYS") Q:X'>1 S X=$$FMADD^XLFDT(Y,(X-1)) 59 I 'ORLAB S X=$$VALUE(DA,"STOP") Q:'$L(X) S:$L(ORT) X=X_"@"_ORT 60 S %DT="T" D ^%DT Q:Y'>0 S:$E($P(Y,".",2),1,2)=24 Y=$P(Y,".")_".2359" 61 S $P(^OR(100,DA,0),U,9)=Y D ES^ORDD100A 62 Q 63 ; 64 NEXT ; -- Resolve next lab collection to FM date/time 65 N ORTIME,ORDAY,NOW,NEXT,ENT 66 S ENT=$S($P($G(^SC(+$G(ORL),0)),U,4):+$P(^(0),U,4),1:+$G(DUZ(2)))_";DIC(4," S:ENT'>0 ENT="ALL" ;is referenced by DBIA #964 67 D GETLST^XPAR(.ORTIME,ENT,"LR PHLEBOTOMY COLLECTION","N") 68 S NOW=$P($H,",",2),ORDAY=$S($O(ORTIME(NOW)):"T",1:"T+1") 69 S ORDAY=$$NEXTCOLL^ORCDLR1(ORDAY) S:ORDAY["+" NOW=0 70 S NEXT=$O(ORTIME(NOW)),X=ORDAY_"@"_$P($G(ORTIME(+NEXT)),U) 71 Q 72 ; 73 AM ; -- Resolve AM lab collection to FM date/time 74 N ORTIME,ORDAY,AM,NOW,ENT 75 S ENT=$S($P($G(^SC(+$G(ORL),0)),U,4):+$P(^(0),U,4),1:+$G(DUZ(2)))_";DIC(4," S:ENT'>0 ENT="ALL" ;is referenced by DBIA #964 76 D GETLST^XPAR(.ORTIME,ENT,"LR PHLEBOTOMY COLLECTION","N") 77 S AM=$O(ORTIME(0)),NOW=$P($H,",",2) 78 S ORDAY=$S(AM=$O(ORTIME(NOW)):"T",1:"T+1") 79 S X=$$NEXTCOLL^ORCDLR1(ORDAY)_"@"_$P($G(ORTIME(+AM)),U) 80 Q 81 ; 82 ADMIN(START) ; -- Resolve next/closest administration times to FM date/time 83 N PAT,SCH,OI,LOC,Y,I 84 I $G(DA) D ;get data from order DA 85 . S PAT=+$P($G(^OR(100,DA,0)),U,2),LOC="" 86 . S I=+$O(^OR(100,DA,4.5,"ID","INSTR",0)),I=+$P($G(^OR(100,DA,4.5,I,0)),U,3) ;first 87 . S SCH=$$VALUE(DA,"SCHEDULE",I),OI=$$VALUE(DA,"ORDERABLE") 88 I '$G(DA) D ;or look in ORDIALOG() instead 89 . S I=+$O(ORDIALOG($$PTR^ORCD("OR GTX INSTRUCTIONS"),0)) 90 . S PAT=$G(ORVP),SCH=$G(ORDIALOG($$PTR^ORCD("OR GTX SCHEDULE"),I)) 91 . S OI=$G(ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1)),LOC="" 92 S OI=+$P($G(^ORD(101.43,+OI,0)),U,2) ;PSOI 93 S Y=$$RESOLVE^PSJORPOE(PAT,SCH,OI,START,LOC),X=$P(Y,U,2) ;is referenced by DBIA #3167 94 Q 95 ; 96 SIGN(DA,WHO,WHEN,HOW,WHAT) ; -- affix ES to order 97 Q:'$G(DA) S:'$G(WHAT) WHAT=1 98 N X S X=$G(^OR(100,DA,8,WHAT,0)) D S2^ORDD100(DA,WHAT) ; kill AS xref 99 S $P(X,U,4,7)=$G(HOW)_U_$G(WHO)_U_$E($G(WHEN),1,12)_U_$S(HOW=0:DUZ,1:"") 100 ; S:$G(WHO) $P(X,U,3)=WHO ; reset provider to signer 101 S ^OR(100,DA,8,WHAT,0)=X 102 D:$G(HOW)=2 S1^ORDD100(DA,WHAT) ; reset AS xref 103 Q 104 ; 105 SIGSTS(IFN,ACT) ; -- Set SigSts for backdoor orders [Called from ^ORM* rtns] 106 ; Expects ORNATR, ORVP, ORNP to be defined 107 Q:'$G(IFN) Q:'$G(ACT) N X,OR0 S OR0=+$P($G(^OR(100,+IFN,8,ACT,0)),U) 108 S X=$S($$SIGNREQD^ORCACT1(+IFN):$$SIGSTS^ORX1(ORNATR),1:3) 109 K ^OR(100,"AS",ORVP,9999999-OR0,+IFN,ACT) 110 S $P(^OR(100,+IFN,8,ACT,0),U,4)=X 111 I X=2 S ^OR(100,"AS",ORVP,9999999-OR0,+IFN,ACT)="" D NOTIF^ORCSIGN 112 Q 113 ; 114 UNVEIL(IFN) ; -- unveil new order 115 S $P(^OR(100,IFN,3),U,8)="" 116 Q 117 ; 118 DELETE(ORDER) ; -- delete order [action] 119 N DIK,DA,DAD 120 I $P(ORDER,";",2)>1 S DA=+$P(ORDER,";",2),DA(1)=+ORDER,DIK="^OR(100,"_DA(1)_",8," D:DA ^DIK Q 121 S DAD=+$P($G(^OR(100,+ORDER,3)),U,9) I DAD S DIK="^OR(100,"_DAD_",2,",DA(1)=DAD,DA=+ORDER D ^DIK ; remove link to child from parent 122 K DA S DA=+ORDER,DIK="^OR(100," D ^DIK ;remove order, text 123 Q 124 ; 125 VERIFY(IFN,DA,TYPE,WHO,WHEN) ; -- order verified 126 Q:'$G(IFN) Q:'$G(DA) Q:"^N^C^R^"'[(U_$G(TYPE)_U) 127 N FLD S FLD=$S(TYPE="N":8,TYPE="C":10,1:18) 128 S:'$G(WHO) WHO=DUZ S:'$G(WHEN) WHEN=+$E($$NOW^XLFDT,1,12) 129 S $P(^OR(100,IFN,8,DA,0),U,FLD,FLD+1)=WHO_U_WHEN 130 Q 131 ; 132 COMP(IFN,WHO,WHEN) ; -- order completed 133 Q:'$G(IFN) S:'$G(WHO) WHO=DUZ S:'$G(WHEN) WHEN=+$E($$NOW^XLFDT,1,12) 134 D DATES(+IFN,,WHEN),STATUS(+IFN,2) 135 S $P(^OR(100,+IFN,6),U,6,7)=WHEN_U_WHO 136 Q 137 ; 138 DATES(DA,START,STOP) ; -- Update start/stop dates for order DA 139 Q:'$G(DA) I $G(START) D 140 . Q:START=$P(^OR(100,DA,0),U,8) 141 . D SK^ORDD100,WK^ORDD100,OI2^ORDD100A(DA) 142 . S $P(^OR(100,DA,0),U,8)=START 143 . D SS^ORDD100,WS^ORDD100,OI1^ORDD100A(DA) 144 I $G(STOP) D 145 . ;Q:STOP=$P(^OR(100,DA,0),U,9) ;ck xref anyway 146 . D EK^ORDD100A S $P(^OR(100,DA,0),U,9)=STOP D ES^ORDD100A 147 Q 148 ; 149 OC ; -- Save order checks in ORCHECK() in ^OR(100,+ORIFN,9) 150 Q:'$G(ORIFN) Q:'$D(^OR(100,+ORIFN,0)) K ^OR(100,+ORIFN,9) 151 N NOW,CNT,CDL,I,OC,OVERIDE S NOW=+$E($$NOW^XLFDT,1,12),CNT=0 152 S CDL=0 F S CDL=$O(ORCHECK(+ORIFN,CDL)) Q:CDL'>0 D 153 . S I=0 F S I=$O(ORCHECK(+ORIFN,CDL,I)) Q:I'>0 D 154 . . S OC=ORCHECK(+ORIFN,CDL,I) Q:'OC 155 . . S OVERIDE=$S($G(MODE)="NOTIF":$G(ORCHECK("OK"))_U,CDL=1:$G(ORCHECK("OK"))_U_DUZ,1:U_DUZ)_U_NOW 156 . . S CNT=CNT+1,^OR(100,+ORIFN,9,"B",+OC,CNT)="" 157 . . S ^OR(100,+ORIFN,9,CNT,0)=$P(OC,U,1,2)_U_U_OVERIDE,^(1)=$E($P(OC,U,3),1,245) 158 S:CNT ^OR(100,+ORIFN,9,0)="^100.09PA^"_CNT_U_CNT 159 Q 160 ; 161 VALUE(IFN,ID,INST) ; -- Returns value of prompt by identifier ID 162 I '$G(IFN)!('$D(^OR(100,+$G(IFN),0)))!($G(ID)="") Q "" 163 N I,Y S I=0,Y="" S:'$G(INST) INST=1 164 F S I=$O(^OR(100,IFN,4.5,"ID",ID,I)) Q:I'>0 I $P($G(^OR(100,IFN,4.5,+I,0)),U,3)=INST S Y=$G(^(1)) Q 165 Q Y 166 ; 167 SC(ORX,ORIFN) ; -- save responses to SC questions 168 Q:'$G(ORIFN) Q:'$D(^OR(100,+ORIFN,0)) ;invalid order number 169 N OR5,I,P S OR5=$G(^OR(100,+ORIFN,5)),P=0 170 F I="SC","MST","AO","IR","EC","HNC","CV" S P=P+1 S:$D(ORX(I)) $P(OR5,U,P)=ORX(I) 171 S ^OR(100,+ORIFN,5)=OR5 172 Q
Note:
See TracChangeset
for help on using the changeset viewer.
