ORWDX2 ; SLC/JM - Order dialog utilities ;11/09/2006 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**246**;Dec 17, 1997;Build 8 ;Per VHA Directive 2004-038, this routine should not be modified. Q ; NXT() ; -- Gets index in array S ILST=ILST+1 Q ILST ; EXTVAL(IVAL,DLG) ; External value given a dlg ptr N ORDIALOG S ORDIALOG(DLG,0)=$P($G(^ORD(101.41,DLG,1)),U,1,2) S ORDIALOG(DLG,1)=IVAL I $E(ORDIALOG(DLG,0))="R",(+IVAL'=IVAL) Q IVAL ; free text date/time Q $$EXT^ORCD(DLG,1) ; all others ; XROOT ; Part of LOADRSP^ORWDX - moved here because of routine size N CHKDOSE,DOSE,INSTR S (ILST,I)=0,CHKDOSE=$$CHKDOSES F S I=$O(@ROOT@(I)) Q:I'>0 D . S DLG=$P(@ROOT@(I,0),U,2),INST=$P(^(0),U,3) . S ID=$P($G(^ORD(101.41,DLG,1)),U,3) . I '$L(ID) S ID="ID"_DLG . S VAL=$G(@ROOT@(I,1)) . I $P($G(^ORD(101.41,DLG,0)),U)="OR GTX ADDITIVE" S ID="ADDITIVE" . I $E(RSPID)="C",(ID="START"),VAL Q ; skip literal start time on copy . S LST($$NXT)="~"_DLG_U_INST_U_ID . I $L(VAL) D .. S LST($$NXT)="i"_VAL,LST($$NXT)="e"_$$EXTVAL(VAL,DLG) .. I CHKDOSE D DOSEINFO . I $D(@ROOT@(I,2))>1 D .. S J=0 F S J=$O(@ROOT@(I,2,J)) Q:J'>0 D ... S LST($$NXT)="t"_$G(@ROOT@(I,2,J,0)) I CHKDOSE D FIXDOSES I $E(ROOT,1,4)="^TMP" K ^TMP("ORWDXMQ",$J) Q ; CHKDOSES() ; Returns true if doses may need to be modified Q $$PATCH^XPDUTL("PSS*1.0*78")&($T(DOSE^PSSORUTE)'="") ; DOSEINFO ; Collect pointers to dose information I ID="INSTR" S INSTR(INST)=ILST-1 I ID="DOSE",+VAL>0 S DOSE(INST)=ILST-1 ; +VAL filters out local dosages Q ; FIXDOSES ; Update doses for those saved before PSS*1*78 was installed N CODE,OLDDOSE,IDX,NEWDOSE,IIDX S IIDX=0 F S IIDX=$O(INSTR(IIDX)) Q:'+IIDX D . I +$G(INSTR(IIDX))>0,+$G(DOSE(IIDX))>0 D .. S OLDDOSE=$E(LST(INSTR(IIDX)),2,999) .. S NEWDOSE=$$DOSE^PSSORUTE(OLDDOSE) .. I OLDDOSE'=NEWDOSE D ... F IDX=0:1:1 D .... S CODE=$E(LST(INSTR(IIDX)+IDX),1) .... S LST(INSTR(IIDX)+IDX)=CODE_NEWDOSE .. S OLDDOSE=$P(LST(DOSE(IIDX)),"&",5) .. S NEWDOSE=$$DOSE^PSSORUTE(OLDDOSE) .. I OLDDOSE'=NEWDOSE D ... F IDX=0:1:1 D .... S $P(LST(DOSE(IIDX)+IDX),"&",5)=NEWDOSE Q