source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXDI02H.m@ 1141

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

initial load of WorldVistAEHR

File size: 4.9 KB
RevLine 
[613]1OCXDI02H ;SLC/RJS,CLA - OCX PACKAGE DIAGNOSTIC ROUTINES ;SEP 7,1999 at 10:30
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5S ;
6 ;
7 D DOT^OCXDIAG
8 ;
9 ;
10 K REMOTE,LOCAL,OPCODE,REF
11 F LINE=1:1:500 S TEXT=$P($T(DATA+LINE),";",2,999) Q:TEXT I $L(TEXT) D Q:QUIT
12 .S ^TMP("OCXDIAG",$J,$O(^TMP("OCXDIAG",$J,"A"),-1)+1)=TEXT
13 ;
14 G ^OCXDI02I
15 ;
16 Q
17 ;
18DATA ;
19 ;
20 ;;D^ ; ;
21 ;;R^"860.8:",100,6
22 ;;D^ ; S OCXLIST="",OCXOI=OCXNAME F S OCXD0=$O(^ORD(101.43,"S."_OCXPKG,OCXOI)) Q:'$L(OCXOI) Q:'($E(OCXOI,1,$L(OCXNAME))=OCXNAME) D
23 ;;R^"860.8:",100,7
24 ;;D^ ; .S OCXD0=0 F S OCXD0=$O(^ORD(101.43,"S."_OCXPKG,OCXD0)) Q:'OCXD0 S OCXLIST=OCXLIST_U_OCXD0
25 ;;R^"860.8:",100,8
26 ;;D^ ; Q OCXLIST
27 ;;R^"860.8:",100,9
28 ;;D^ ; ;
29 ;;EOR^
30 ;;KEY^860.8:^LOG DATA FIELD WITH VALUE
31 ;;R^"860.8:",.01,"E"
32 ;;D^LOG DATA FIELD WITH VALUE
33 ;;R^"860.8:",.02,"E"
34 ;;D^LOGDF
35 ;;R^"860.8:",100,1
36 ;;D^ ;LOGDF(DFLD,CONTEXT,VALUE) ;
37 ;;R^"860.8:",100,2
38 ;;D^ ; ;
39 ;;R^"860.8:",100,3
40 ;;D^ ; I $G(DFLD),$G(CONTEXT),$L($G(VALUE)) D
41 ;;R^"860.8:",100,4
42 ;;D^ ; .Q:'$D(^OCXS(860.4,DFLD,0))
43 ;;R^"860.8:",100,5
44 ;;D^ ; .S ^OCXS(860.4,DFLD,"LINK",CONTEXT,"STAT")=$G(^OCXS(860.4,DFLD,"LINK",CONTEXT,"STAT"))+1
45 ;;R^"860.8:",100,6
46 ;;D^ ; Q 0
47 ;;EOR^
48 ;;KEY^860.8:^EXTERNAL TO OERR PACKAGE
49 ;;R^"860.8:",.01,"E"
50 ;;D^EXTERNAL TO OERR PACKAGE
51 ;;R^"860.8:",.02,"E"
52 ;;D^EXTOERR
53 ;;R^"860.8:",100,1
54 ;;D^EXTOERR(PKG1,PKG2) ;
55 ;;R^"860.8:",100,2
56 ;;D^ ;
57 ;;R^"860.8:",100,3
58 ;;D^ I $L($G(PKG1)),'(PKG1="ORDER ENTRY") Q PKG1
59 ;;R^"860.8:",100,4
60 ;;D^ Q $G(PKG2)
61 ;;R^"860.8:",100,5
62 ;;D^ ;
63 ;;EOR^
64 ;;KEY^860.8:^STRING CONTAINS ONE OF A LIST OF VALUES
65 ;;R^"860.8:",.01,"E"
66 ;;D^STRING CONTAINS ONE OF A LIST OF VALUES
67 ;;R^"860.8:",.02,"E"
68 ;;D^CLIST
69 ;;R^"860.8:",100,1
70 ;;D^ ;CLIST(DATA,LIST) ; DOES THE DATA FIELD CONTAIN AN ELEMENT IN THE LIST
71 ;;R^"860.8:",100,2
72 ;;D^ ; ;
73 ;;R^"860.8:",100,3
74 ;;D^T+; W:$G(OCXTRACE) !!,"$$CLIST(",DATA,",""",LIST,""")"
75 ;;R^"860.8:",100,4
76 ;;D^ ; N PC F PC=1:1:$L(LIST,","),0 I PC,$L($P(LIST,",",PC)),(DATA[$P(LIST,",",PC)) Q
77 ;;R^"860.8:",100,5
78 ;;D^ ; Q ''PC
79 ;;EOR^
80 ;;KEY^860.8:^GET WARD SERVICE
81 ;;R^"860.8:",.01,"E"
82 ;;D^GET WARD SERVICE
83 ;;R^"860.8:",.02,"E"
84 ;;D^WARDSERV
85 ;;R^"860.8:",100,1
86 ;;D^ ;WARDSERV(WARD) ;
87 ;;R^"860.8:",100,2
88 ;;D^ ; ;
89 ;;R^"860.8:",100,3
90 ;;D^ ; N CODESET,PC,SERV,DIC,X,Y,DA
91 ;;R^"860.8:",100,4
92 ;;D^ ; S CODESET="M:MEDICINE;S:SURGERY;P:PSYCHIATRY;NH:NHCU;NE:NEUROLOGY;I:INTERMEDIATE MED;R:REHAB MEDICINE;SCI:SPINAL CORD INJURY;D:DOMICILIARY;B:BLIND REHAB;NC:NON-COUNT"
93 ;;R^"860.8:",100,5
94 ;;D^ ; S DIC=42,DIC(0)="NZ",X="`"_(+WARD) D ^DIC Q:(Y<1) ""
95 ;;R^"860.8:",100,6
96 ;;D^ ; S SERV=$P($G(Y(0)),U,3)
97 ;;R^"860.8:",100,7
98 ;;D^ ; Q:'$L(SERV) "" Q:'$L(CODESET) ""
99 ;;R^"860.8:",100,8
100 ;;D^ ; F PC=1:1:$L(CODESET,";"),0 I PC,($P($P(CODESET,";",PC),":",1)=SERV) Q
101 ;;R^"860.8:",100,9
102 ;;D^ ; Q:'PC "" Q $P($P(CODESET,";",PC),":",2)
103 ;;R^"860.8:",100,10
104 ;;D^ ; ;
105 ;;EOR^
106 ;;KEY^860.8:^GET ORDERABLE ITEM FROM ORDER NUMBER
107 ;;R^"860.8:",.01,"E"
108 ;;D^GET ORDERABLE ITEM FROM ORDER NUMBER
109 ;;R^"860.8:",.02,"E"
110 ;;D^ORDITEM
111 ;;R^"860.8:",100,1
112 ;;D^ ;ORDITEM(OIEN) ;
113 ;;R^"860.8:",100,2
114 ;;D^ ;
115 ;;R^"860.8:",100,3
116 ;;D^ ; Q:'$G(OIEN) ""
117 ;;R^"860.8:",100,4
118 ;;D^ ; ;
119 ;;R^"860.8:",100,5
120 ;;D^ ; N OITXT,X S OITXT=$$OI^ORQOR2(OIEN) Q:'OITXT "No orderable item found."
121 ;;R^"860.8:",100,6
122 ;;D^ ; S X=$G(^ORD(101.43,+OITXT,0)) Q:'$L(X) "No orderable item found."
123 ;;R^"860.8:",100,7
124 ;;D^ ; Q $P(X,U,1)
125 ;;R^"860.8:",100,8
126 ;;D^ ; ;
127 ;;EOR^
128 ;;KEY^860.8:^CONVERT DATE FROM OCX FORMAT TO READABLE FORMAT
129 ;;R^"860.8:",.01,"E"
130 ;;D^CONVERT DATE FROM OCX FORMAT TO READABLE FORMAT
131 ;;R^"860.8:",.02,"E"
132 ;;D^INT2DT
133 ;;R^"860.8:",1,1
134 ;;D^ ;INT2DT(OCXDT,OCXF) ; This Local Extrinsic Function converts an OCX internal format
135 ;;R^"860.8:",1,2
136 ;;D^ ; ; date into an Externl Format (Human Readable) date. 'OCXF=SHORT FORMAT OCXF=LONG FORMAT
137 ;;R^"860.8:",1,3
138 ;;D^ ; ;
139 ;;R^"860.8:",100,1
140 ;;D^ ;INT2DT(OCXDT,OCXF) ; This Local Extrinsic Function converts an OCX internal format
141 ;;R^"860.8:",100,2
142 ;;D^ ; ; date into an Externl Format (Human Readable) date. 'OCXF=SHORT FORMAT OCXF=LONG FORMAT
143 ;;R^"860.8:",100,3
144 ;;D^ ; ;
145 ;;R^"860.8:",100,4
146 ;;D^ ; Q:'$L($G(OCXDT)) "" S OCXF=+$G(OCXF)
147 ;;R^"860.8:",100,5
148 ;;D^ ; N OCXYR,OCXLPYR,OCXMON,OCXDAY,OCXHR,OCXMIN,OCXSEC,OCXCYR
149 ;;R^"860.8:",100,6
150 ;;D^ ; S (OCXYR,OCXLPYR,OCXMON,OCXDAY,OCXHR,OCXMIN,OCXSEC,OCXAP)=""
151 ;;R^"860.8:",100,7
152 ;;D^ ; S OCXSEC=$E(OCXDT#60+100,2,3),OCXDT=OCXDT\60
153 ;;R^"860.8:",100,8
154 ;;D^ ; S OCXMIN=$E(OCXDT#60+100,2,3),OCXDT=OCXDT\60
155 ;;R^"860.8:",100,9
156 ;;D^ ; S OCXHR=$E(OCXDT#24+100,2,3),OCXDT=OCXDT\24
157 ;;R^"860.8:",100,10
158 ;;D^ ; S OCXCYR=($H\1461)*4+1841+(($H#1461)\365)
159 ;;R^"860.8:",100,11
160 ;;D^ ; S OCXYR=(OCXDT\1461)*4+1841,OCXDT=OCXDT#1461
161 ;;R^"860.8:",100,12
162 ;;D^ ; S OCXLPYR=(OCXDT\365),OCXDT=OCXDT-(OCXLPYR*365),OCXYR=OCXYR+OCXLPYR
163 ;;R^"860.8:",100,13
164 ;;D^ ; S OCXCNT="031^059^090^120^151^181^212^243^273^304^334^365"
165 ;1;
166 ;
Note: See TracBrowser for help on using the repository browser.