source: FOIAVistA/tag/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDXQ.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1ORWDXQ ; SLC/KCM - Utilities for Quick Orders;06:18 PM 27 Apr 1998
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,245**;Dec 17, 1997;Build 2
3 ;
4DLGNAME(VAL,INAME) ; Return display name for a dialog (DELETE??)
5 N IEN S IEN=$O(^ORD(101.41,"B",INAME,0))
6 S VAL=$P($G(^ORD(101.41,IEN,5)),U,4)
7 Q
8DLGSAVE(VAL,CRC,DNAME,DGRP,RSP) ; Return IEN of new or existing quick order
9 N ROOT,NM,IEN
10 S ROOT="ORWDQ "_CRC,VAL=0,IEN=+$O(^ORD(101.41,"B",ROOT,0))
11 I IEN=0 D SAVENEW(.VAL,ROOT,DNAME,DGRP,.RSP) I 1
12 E I $$MATCH(IEN,DGRP,.RSP) S VAL=IEN I 1
13 E D
14 . D UPDQNAME^ORCMEDT8(IEN)
15 . S ROOT=$$ENSURNEW^ORCMEDT8(ROOT)
16 . D SAVENEW(.VAL,ROOT,DNAME,DGRP,.RSP)
17 Q
18OLDELSE E D ; this creates other entries if CRC matches...
19 . S NM=ROOT
20 . F S NM=$O(^ORD(101.41,"B",NM)) Q:$E(NM,1,$L(ROOT))'=ROOT D
21 . . S IEN=0 F S IEN=$O(^ORD(101.41,"B",ROOT,0)) Q:IEN'>0 D Q:VAL
22 . . . I $$MATCH(IEN,DGRP,RSP) S VAL=IEN
23 . . I 'VAL D ; new entry by same CRC (rare!)
24 . . . F I=1:1 I '$D(^ORD(101.41,"B",ROOT_" "_I)) Q
25 . . . D SAVENEW(VAL,ROOT_" "_I,DNAME,DGRP,RSP)
26 Q
27MATCH(IEN,DGRP,RSP) ; Called by DLGSAVE
28 ; Return true if the responses passed in match dialog
29 I $P(^ORD(101.41,IEN,0),U,5)'=DGRP Q 0 ; display group must match
30 N TST,RSLT,DLG,INST,VAL,I,J,L
31 S RSLT=1 M TST=RSP
32 S I=0 F S I=$O(^ORD(101.41,IEN,6,I)) Q:'I D Q:'RSLT
33 . S DLG=$P(^ORD(101.41,IEN,6,I,0),U,2),INST=$P(^(0),U,3)
34 . S VAL="ORDIALOG(""WP"","_DLG_","_INST_")"
35 . I $D(^ORD(101.41,IEN,6,I,1)) S VAL=^(1)
36 . I '$D(TST(DLG,INST)) S RSLT=0 Q
37 . I TST(DLG,INST)'=VAL S RSLT=0 Q
38 . I $D(^ORD(101.41,IEN,6,I,2))>1 D Q:'RSLT
39 . . N A,B,JMAX
40 . . S (J,L)=0 F S L=$O(^ORD(101.41,IEN,6,I,2,L)) Q:'L S J=J+1,A(J)=^(L,0)
41 . . S JMAX=J
42 . . S (J,L)=0 F S L=$O(TST("WP",DLG,INST,L)) Q:'L S J=J+1,B(J)=TST("WP",DLG,INST,L,0)
43 . . I JMAX'=J S RSLT=0 Q
44 . . S J=0 F S J=$O(A(J)) Q:'J S:A(J)'=$G(B(J)) RSLT=0 Q:'RSLT K A(J),B(J)
45 . . I ($D(A)>1)!($D(B)>1) S RSLT=0
46 . . K TST("WP",DLG,INST)
47 . K TST(DLG,INST)
48 I $D(TST)>1 S RSLT=0
49 Q RSLT
50SAVENEW(ORQDLG,INM,DTX,DG,ORDIALOG) ; Called by DLGSAVE
51 ; save the entries in ORDIALOG as a new quick order
52 ; INM=.01 name, DTX=display text, DGR=display group
53 S ORQDLG=0,ORDIALOG=$$DEFDLG(DG) Q:'ORDIALOG
54 D GETDLG1^ORCD(ORDIALOG)
55 N FDA,FDAIEN,DIERR,ORDG
56 S FDA(101.41,"+1,",.01)=INM
57 S FDA(101.41,"+1,",2)=DTX
58 S FDA(101.41,"+1,",4)="Q"
59 S FDA(101.41,"+1,",5)=DG
60 D UPDATE^DIE("","FDA","FDAIEN")
61 S ORQDLG=FDAIEN(1)
62 D SAVE^ORCMEDT1
63 Q
64DEFDLG(DG) ; Return IEN of default dialog for display group
65 N DLG,DAD S DLG=+$P($G(^ORD(100.98,DG,0)),U,4)
66 I 'DLG S DAD=$O(^ORD(100.98,"AD",DG,0)) I DAD S DLG=$$DEFDLG(DAD)
67 Q DLG
68GETQLST(LST,DGRP,PRE) ; Return quick list for a display group
69 N LVW,ILST,I,X0
70 S PRE=$G(PRE),ILST=0
71 D QV4DG^ORWUL(.LVW,DGRP) S LVW=+LVW Q:'LVW
72 S I=0 F S I=$O(^ORD(101.44,LVW,10,I)) Q:'I D
73 . S X0=$G(^ORD(101.44,LVW,10,I,0))
74 . I $P($G(^ORD(101.41,+X0,0)),U,3)]"" Q ; quick order is disabled
75 . S ILST=ILST+1,LST(ILST)=PRE_X0
76 Q
77 ;N DNAM,DLG,I,ILST,X
78 ;S ILST=0,X="ORWDQ "_$S(+DGRP:$P(^ORD(100.98,DGRP,0),U,3),1:DGRP),PRE=$G(PRE)
79 ;D GETLST^XPAR(.TMP,"ALL",X,"N")
80 ;S I=0 F S I=$O(TMP(I)) Q:'I S DLG=+TMP(I) I +DLG D
81 ;. S DNAM=$$GET^XPAR(DUZ_";VA(200,","ORWDQ DISPLAY NAME",DLG,"I")
82 ;. I '$L(DNAM) S DNAM=$P(^ORD(101.41,DLG,0),U,2)
83 ;. I $P($G(^ORD(101.41,DLG,0)),U,3)]"" Q ; quick order is disabled
84 ;. S ILST=ILST+1,LST(ILST)=PRE_DLG_U_DNAM
85 ;Q
86PUTQLST(VAL,DG,QLST) ; Save quick list
87 N PNM
88 S PNM="ORWDQ USR"_DUZ_" "_$P(^ORD(100.98,DG,0),U,3)
89 D QVSAVE^ORWUL(.VAL,PNM,.QLST)
90 D EN^XPAR(DUZ_";VA(200,","ORWDQ QUICK VIEW","`"_DG,PNM)
91 Q
92 ;N PNM,USER,I,DLG,QNM,CUR
93 ;S PNM="ORWDQ "_$P(^ORD(100.98,DG,0),U,3),USER=DUZ_";VA(200,"
94 ;D NDEL^XPAR(USER,PNM) ; remove all instances for this quick list
95 ;S I=0 F S I=$O(QLST(I)) Q:'I D ADD^XPAR(USER,PNM,I,"`"_+QLST(I))
96 ;S I=0 F S I=$O(QLST(I)) Q:'I D
97 ;. S DLG=+QLST(I),QNM=$P(QLST(I),U,2)
98 ;. S CUR=$$GET^XPAR(USER,"ORWDQ DISPLAY NAME",DLG,"I")
99 ;. I QNM=CUR Q
100 ;. I CUR="",(QNM=$P($G(^ORD(101.41,DLG,0)),U,2)) Q
101 ;. D EN^XPAR(USER,"ORWDQ DISPLAY NAME","`"_DLG,QNM)
102 ;Q
103GETQNAM(VAL,CRC) ; Return current quick name
104 N ROOT S ROOT="ORWDQ "_CRC,VAL=""
105 I '$D(^ORD(101.41,"B",ROOT)) Q
106 S DLG=$O(^ORD(101.41,"B",ROOT,0))
107 ; S VAL=$$GET^XPAR(DUZ_";VA(200,","ORWDQ DISPLAY NAME",DLG,"I")
108 I '$L(VAL) S VAL=$P($G(^ORD(101.41,DLG,0)),U,2)
109 Q
110PUTQNAM(VAL,DLG,QNAM) ; Save display name for a quick order dialog
111 ; see if DLG used QNAM as display text (quit if so)
112 ; otherwise save in ORWDQ DISPLAY NAME
113 Q
Note: See TracBrowser for help on using the repository browser.