| 1 | ORWDX2 ; SLC/JM - Order dialog utilities ;11/09/2006
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**246**;Dec 17, 1997;Build 8
|
|---|
| 3 | ;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | NXT() ; -- Gets index in array
|
|---|
| 7 | S ILST=ILST+1
|
|---|
| 8 | Q ILST
|
|---|
| 9 | ;
|
|---|
| 10 | EXTVAL(IVAL,DLG) ; External value given a dlg ptr
|
|---|
| 11 | N ORDIALOG
|
|---|
| 12 | S ORDIALOG(DLG,0)=$P($G(^ORD(101.41,DLG,1)),U,1,2)
|
|---|
| 13 | S ORDIALOG(DLG,1)=IVAL
|
|---|
| 14 | I $E(ORDIALOG(DLG,0))="R",(+IVAL'=IVAL) Q IVAL ; free text date/time
|
|---|
| 15 | Q $$EXT^ORCD(DLG,1) ; all others
|
|---|
| 16 | ;
|
|---|
| 17 | XROOT ; Part of LOADRSP^ORWDX - moved here because of routine size
|
|---|
| 18 | N CHKDOSE,DOSE,INSTR
|
|---|
| 19 | S (ILST,I)=0,CHKDOSE=$$CHKDOSES
|
|---|
| 20 | F S I=$O(@ROOT@(I)) Q:I'>0 D
|
|---|
| 21 | . S DLG=$P(@ROOT@(I,0),U,2),INST=$P(^(0),U,3)
|
|---|
| 22 | . S ID=$P($G(^ORD(101.41,DLG,1)),U,3)
|
|---|
| 23 | . I '$L(ID) S ID="ID"_DLG
|
|---|
| 24 | . S VAL=$G(@ROOT@(I,1))
|
|---|
| 25 | . I $P($G(^ORD(101.41,DLG,0)),U)="OR GTX ADDITIVE" S ID="ADDITIVE"
|
|---|
| 26 | . I $E(RSPID)="C",(ID="START"),VAL Q ; skip literal start time on copy
|
|---|
| 27 | . S LST($$NXT)="~"_DLG_U_INST_U_ID
|
|---|
| 28 | . I $L(VAL) D
|
|---|
| 29 | .. S LST($$NXT)="i"_VAL,LST($$NXT)="e"_$$EXTVAL(VAL,DLG)
|
|---|
| 30 | .. I CHKDOSE D DOSEINFO
|
|---|
| 31 | . I $D(@ROOT@(I,2))>1 D
|
|---|
| 32 | .. S J=0 F S J=$O(@ROOT@(I,2,J)) Q:J'>0 D
|
|---|
| 33 | ... S LST($$NXT)="t"_$G(@ROOT@(I,2,J,0))
|
|---|
| 34 | I CHKDOSE D FIXDOSES
|
|---|
| 35 | I $E(ROOT,1,4)="^TMP" K ^TMP("ORWDXMQ",$J)
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | CHKDOSES() ; Returns true if doses may need to be modified
|
|---|
| 39 | Q $$PATCH^XPDUTL("PSS*1.0*78")&($T(DOSE^PSSORUTE)'="")
|
|---|
| 40 | ;
|
|---|
| 41 | DOSEINFO ; Collect pointers to dose information
|
|---|
| 42 | I ID="INSTR" S INSTR(INST)=ILST-1
|
|---|
| 43 | I ID="DOSE",+VAL>0 S DOSE(INST)=ILST-1 ; +VAL filters out local dosages
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | FIXDOSES ; Update doses for those saved before PSS*1*78 was installed
|
|---|
| 47 | N CODE,OLDDOSE,IDX,NEWDOSE,IIDX
|
|---|
| 48 | S IIDX=0
|
|---|
| 49 | F S IIDX=$O(INSTR(IIDX)) Q:'+IIDX D
|
|---|
| 50 | . I +$G(INSTR(IIDX))>0,+$G(DOSE(IIDX))>0 D
|
|---|
| 51 | .. S OLDDOSE=$E(LST(INSTR(IIDX)),2,999)
|
|---|
| 52 | .. S NEWDOSE=$$DOSE^PSSORUTE(OLDDOSE)
|
|---|
| 53 | .. I OLDDOSE'=NEWDOSE D
|
|---|
| 54 | ... F IDX=0:1:1 D
|
|---|
| 55 | .... S CODE=$E(LST(INSTR(IIDX)+IDX),1)
|
|---|
| 56 | .... S LST(INSTR(IIDX)+IDX)=CODE_NEWDOSE
|
|---|
| 57 | .. S OLDDOSE=$P(LST(DOSE(IIDX)),"&",5)
|
|---|
| 58 | .. S NEWDOSE=$$DOSE^PSSORUTE(OLDDOSE)
|
|---|
| 59 | .. I OLDDOSE'=NEWDOSE D
|
|---|
| 60 | ... F IDX=0:1:1 D
|
|---|
| 61 | .... S $P(LST(DOSE(IIDX)+IDX),"&",5)=NEWDOSE
|
|---|
| 62 | Q
|
|---|
