source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDX2.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.1 KB
Line 
1ORWDX2 ; 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 ;
6NXT() ; -- Gets index in array
7 S ILST=ILST+1
8 Q ILST
9 ;
10EXTVAL(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 ;
17XROOT ; 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 ;
38CHKDOSES() ; Returns true if doses may need to be modified
39 Q $$PATCH^XPDUTL("PSS*1.0*78")&($T(DOSE^PSSORUTE)'="")
40 ;
41DOSEINFO ; 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 ;
46FIXDOSES ; 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
Note: See TracBrowser for help on using the repository browser.