source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOED13.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 5.4 KB
Line 
1OCXOED13 ;SLC/RJS,CLA - Rule Editor (Meta Dictionary Link Display) ;10/29/98 12:37
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5 ;
6S ;
7 ;
8 Q
9EN(OCXLNK,OCXSRC) ;
10 ;
11 N OCXACT,OCXRD
12 S OCXD0=+$$DIC("^OCXS(863.3,","XM","",OCXLNK)
13 I '(OCXD0>0) S OCXD0=$$ADDLINK(OCXLNK,OCXSRC) Q:'OCXD0
14 F K OCXRD,OCXACT S (OCXRD,OCXACT)="" D DISP(OCXD0,.OCXRD,.OCXACT) Q:$$EN^OCXOED14(OCXD0,.OCXRD,.OCXACT)
15 ;
16 Q
17 ;
18DISP(OCXD0,OCXRD,OCXACT) ;
19 ;
20 N OCXTHLN,OCXTNLN,OCXTRLN,OCXTULN,OCXTNLN
21 S OCXTNLN=$C(27,91,48,109),OCXTRLN=$C(27,91,55,109),OCXTULN=$C(27,91,52,109),OCXTHLN=$C(27,91,49,109)
22 D GETDATA(OCXD0,.OCXRD)
23 D CHKVR(OCXD0,.OCXRD)
24 ;
25 W @IOF,OCXTNLN
26 W !,$$CENTER($$FIELD("Meta Dictionary Edit Screen"),80),!
27 W !," ",$$FIELD("Link:")," ",$$DATA($G(OCXRD("LINK",OCXD0,.01,"E")),50)
28 W !," ",$$FIELD(" Subject:")," ",$$DATA($G(OCXRD("LINK",OCXD0,.02,"E")),50)
29 W !," ",$$OPT^OCXOEDT("Change Attribute","EDATT","14",.OCXACT,OCXD0,"CA")
30 W " ",$$FIELD(" Attribute:")," ",$$DATA($G(OCXRD("LINK",OCXD0,.05,"E")),50)
31 ;
32 W !!,$$SEP("Parameters"),!
33 ;
34 W !," ",$$OPT^OCXOEDT("P1","EDPARAM","14",.OCXACT,OCXD0_",""OCXO EXTERNAL FUNCTION CALL""")
35 W " ",$$FIELD(" M Function Call: ")," ",$$DATA($$PVAL("LINK",OCXD0,"OCXO EXTERNAL FUNCTION CALL"),30)
36 W !," ",$$OPT^OCXOEDT("P2","EDPARAM","14",.OCXACT,OCXD0_",""OCXO VARIABLE NAME""")
37 W " ",$$FIELD(" Data Variable Name: ")," ",$$DATA($$PVAL("LINK",OCXD0,"OCXO VARIABLE NAME"),30)
38 W !," ",$$OPT^OCXOEDT("P3","EDPARAM","14",.OCXACT,OCXD0_",""OCXO VT-BAR PIECE NUMBER""")
39 W " ",$$FIELD(" Vertical Bar '|' Piece Number: ")," ",$$DATA($$PVAL("LINK",OCXD0,"OCXO VT-BAR PIECE NUMBER"),30)
40 W !," ",$$OPT^OCXOEDT("P4","EDPARAM","14",.OCXACT,OCXD0_",""OCXO UP-ARROW PIECE NUMBER""")
41 W " ",$$FIELD(" Up Arrow '^' Piece Number: ")," ",$$DATA($$PVAL("LINK",OCXD0,"OCXO UP-ARROW PIECE NUMBER"),30)
42 W !," ",$$OPT^OCXOEDT("P5","EDPARAM","14",.OCXACT,OCXD0_",""OCXO SEMI-COLON PIECE NUMBER""")
43 W " ",$$FIELD(" Semi Colon ';' Piece Number: ")," ",$$DATA($$PVAL("LINK",OCXD0,"OCXO SEMI-COLON PIECE NUMBER"),30)
44 W !," ",$$OPT^OCXOEDT("P6","EDPARAM","14",.OCXACT,OCXD0_",""OCXO FILE POINTER""")
45 W " ",$$FIELD(" Pointed To File Number: ")," ",$$DATA($$PVAL("LINK",OCXD0,"OCXO FILE POINTER"),30)
46 W !," ",$$OPT^OCXOEDT("P7","EDPARAM","14",.OCXACT,OCXD0_",""OCXO HL7 SEGMENT ID""")
47 W " ",$$FIELD(" HL7 Segment ID: ")," ",$$DATA($$PVAL("LINK",OCXD0,"OCXO HL7 SEGMENT ID"),30)
48 I +$G(OCXRD("LINK",OCXD0,.05,"I")) D
49 .W !!," ",$$OPT^OCXOEDT("Data Type","EDPATT","14",.OCXACT,(+$G(OCXRD("LINK",OCXD0,.05,"I")))_",""DATA TYPE""","DT")
50 .W " ",$$FIELD(" Attribute Data Type: ")," ",$$DATA($$PVAL("ATT",+$G(OCXRD("LINK",OCXD0,.05,"I")),"DATA TYPE"),30)
51 ;
52 Q
53 ;
54PVAL(SUB,OCXD0,PNAME) ;
55 N X S X="" F S X=$O(OCXRD(SUB,OCXD0,"PAR",X)) Q:'X I ($G(OCXRD(SUB,OCXD0,"PAR",X,.01,"E"))=PNAME) Q
56 Q:'X "" Q $G(OCXRD(SUB,OCXD0,"PAR",X,1,"E"))
57 ;
58CHKVR(OCXD0,OCXRD) ;
59 ;
60 N OCXVNM,OCXSID,OCXVPN
61 ;
62 S OCXVNM=$$PVAL("LINK",OCXD0,"OCXO VARIABLE NAME")
63 S OCXVPN=$$PVAL("LINK",OCXD0,"OCXO VT-BAR PIECE NUMBER")
64 S OCXSID=$$PVAL("LINK",OCXD0,"OCXO HL7 SEGMENT ID")
65 ;
66 ;
67 I '$L(OCXVNM),$L(OCXVPN),$L(OCXSID) D
68 .N OCXVAR S OCXVAR="OCXODATA("""_OCXSID_""","_OCXVPN_")"
69 .D SLPVAL^OCXOED14(OCXD0,"OCXO VARIABLE NAME",OCXVAR)
70 .D SLPVAL^OCXOED14(OCXD0,"OCXO VT-BAR PIECE NUMBER","@")
71 .D SLPVAL^OCXOED14(OCXD0,"OCXO HL7 SEGMENT ID","@")
72 .K OCXRD S OCXRD="" D GETDATA(OCXD0,.OCXRD)
73 Q
74 ;
75 Q
76CENTER(X,M) ;
77 N SP S SP="",$P(SP," ",80)=" " Q $E(SP,1,((M\2)-($L(X)\2)))_X
78 ;
79SEP(OCXHDR) ;
80 ;
81 N SPACES S SPACES="",$P(SPACES," ",80-$L(OCXHDR))=" " Q OCXTNLN_OCXTHLN_OCXTULN_$G(OCXHDR)_SPACES_OCXTNLN
82 ;
83FIELD(OCXHDR) ;
84 ;
85 Q OCXTHLN_$G(OCXHDR)_OCXTNLN
86 ;
87DATA(OCXVAL,OCXLEN) ;
88 ;
89 N SPACES S SPACES="",$P(SPACES," ",OCXLEN+5)=" ",OCXVAL=$G(OCXVAL)
90 I ($L(OCXVAL)>OCXLEN) Q $E(OCXVAL,1,OCXLEN-3)_"..."
91 Q $E((OCXVAL_SPACES),1,OCXLEN)
92 ;
93GETDATA(OCXD0,OCXD) ;
94 ;
95 N OCXDIQ,OCXX,OCXATT,OCXSUB
96 ;
97 S OCXDIQ="" D DIQ("^OCXS(863.3,",OCXD0,"IEN",.OCXDIQ)
98 M OCXD("LINK")=OCXDIQ(863.3) K OCXDIQ S OCXDIQ=""
99 S OCXX=0 F S OCXX=$O(^OCXS(863.3,OCXD0,"PAR",OCXX)) Q:'OCXX W "." D
100 .S OCXDIQ="" D DIQ("^OCXS(863.3,"_OCXD0_",""PAR"",",OCXX,"IEN",.OCXDIQ)
101 .M OCXD("LINK",OCXD0,"PAR")=OCXDIQ(863.32) K OCXDIQ S OCXDIQ=""
102 ;
103 S OCXDIQ="",OCXSUB=$G(OCXD("LINK",OCXD0,.02,"I")) I OCXSUB D
104 .D DIQ("^OCXS(863.2,",OCXSUB,"IEN",.OCXDIQ)
105 .M OCXD("SUB")=OCXDIQ(863.2) K OCXDIQ S OCXDIQ=""
106 ;
107 S OCXDIQ="",OCXATT=$G(OCXD("LINK",OCXD0,.05,"I")) I OCXATT D
108 .D DIQ("^OCXS(863.4,",OCXATT,"IEN",.OCXDIQ)
109 .M OCXD("ATT")=OCXDIQ(863.4) K OCXDIQ S OCXDIQ=""
110 .S OCXX=0 F S OCXX=$O(^OCXS(863.4,OCXATT,"PAR",OCXX)) Q:'OCXX W "." D
111 ..S OCXDIQ="" D DIQ("^OCXS(863.4,"_OCXATT_",""PAR"",",OCXX,"IEN",.OCXDIQ)
112 ..M OCXD("ATT",OCXATT,"PAR")=OCXDIQ(863.41) K OCXDIQ S OCXDIQ=""
113 Q
114 ;
115DIC(OCXDIC,OCXDIC0,OCXDICA,OCXX,OCXDICS,OCXDR) ;
116 ;
117 N DIC,X,Y
118 S DIC=$G(OCXDIC) Q:'$L(DIC) -1
119 S DIC(0)=$G(OCXDIC0) S:$L($G(OCXX)) X=OCXX
120 S:$L($G(OCXDICS)) DIC("S")=OCXDICS
121 S:$L($G(OCXDICA)) DIC("A")=OCXDICA
122 S:$L($G(OCXDR)) DIC("DR")=OCXDR
123 D ^DIC Q:(Y<1) 0 Q Y
124 ;
125DIQ(DIC,DA,OCXDIQ0,OCXARY) ;
126 N DR,DIQ S DR=".01:99999",DIQ="OCXARY(",DIQ(0)=$G(OCXDIQ0)
127 D EN^DIQ1
128 Q
129 ;
130ADDLINK(OCXNAME,OCXSRC) ;
131 N OCXD0,OCXDR
132 S OCXD0=+$$DIC("^OCXS(863.2,","XLME","",$P(OCXNAME,".",1)) Q:(OCXD0<1) 0
133 S OCXDR=".02///"_$P(OCXNAME,".",1)_";.04///"_OCXSRC_";.06///99"
134 S OCXD0=+$$DIC("^OCXS(863.3,","XLME","",OCXNAME,"",OCXDR)
135 Q:(OCXD0<1) 0 Q OCXD0
136 ;
Note: See TracBrowser for help on using the repository browser.