source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOCMPQ.m@ 1450

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1OCXOCMPQ ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Sort Code Segments cont...) ;3/21/01 10:17
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5 ;
6TIME(T,OCXD0,OCXD1) ;
7 ;
8 N TIME
9 S TIME=""
10 I (T["|") D
11 .N DAY,OPER,OFFS
12 .I ($E(T,1)="|") S DAY=$P(T,"|",2) I $L(DAY) S DAY=$$DFLKUP(DAY) I DAY S DAY="|"_$P(T,"|",2)_"|"
13 .E Q
14 .S OPER=$P($P(T,"|",3)," ",2) I '(OPER="+"),'(OPER="-") Q
15 .S OFFS=$P($P(T,"|",3)," ",3) I '(OFFS?1.N1"H"),'(OFFS?1.N1"D"),'(OFFS?1.N1"W"),'(OFFS?1.N1"M") Q
16 .S TIME=$$XLATE(DAY,OCXD0,OCXD1)_","""_OPER_""","""_OFFS_""""
17 I '(T["|") D
18 .N DAY,OPER,OFFS
19 .S DAY=$P(T," ",1) I '(DAY="TODAY"),'(DAY="NOW") Q
20 .S OPER=$P(T," ",2) I '(OPER="+"),'(OPER="-") Q
21 .S OFFS=$P(T," ",3) I '(OFFS?1.N1"H"),'(OFFS?1.N1"D"),'(OFFS?1.N1"W"),'(OFFS?1.N1"M") Q
22 .S TIME=""""_$E(DAY,1)_""","""_OPER_""","""_OFFS_""""
23 Q TIME
24 ;
25DFLKUP(X) ;
26 N XL,Y
27 S Y=0 F XL=$L(X):-1:1 Q:Y S Y=0 F S Y=$O(^OCXS(860.4,"B",$E(X,1,XL),Y)) Q:'Y Q:($P($G(^OCXS(860.4,Y,0)),U,1)=X)
28 Q Y
29 ;
30XLATE(MSG,D0,D1,OCXDTCD) ;
31 ;
32 N PIEC,ERROR S ERROR=0
33 S OCXDTCD=+$G(OCXDTCD)
34 I (MSG["|") S:('$L(MSG,"|")#2) MSG=MSG_"|" F PIEC=2:2:$L(MSG,"|") D Q:ERROR
35 .N FLD,ELIST,LABEL,D2,DFLD,TEMP
36 .S FLD=$P(MSG,"|",PIEC),(DFLD,ELIST)=0,GETDATA=""
37 .I (FLD[".") D I 1
38 ..S LABEL=$P(FLD,".",1),DFLD=$P(FLD,".",2),D2=0
39 ..I $L(LABEL) S D2=$O(^OCXS(860.2,D0,"C","B",LABEL,0)) S:'D2 D2=$O(^OCXS(860.2,D0,"C","C",LABEL,0))
40 ..S:D2 ELIST=+$P($G(^OCXS(860.2,D0,"C",D2,0)),U,2)
41 ..S:$L(DFLD) DFLD=$$GETDF(DFLD)
42 .E D
43 ..S ELIST="" S:$L(FLD) DFLD=$$GETDF(FLD) Q:'DFLD
44 ..S D2=0 F S D2=$O(^TMP("OCXCMP",$J,"RULE",D0,D1,D2)) Q:'D2 S:$L(ELIST) ELIST=ELIST_U S ELIST=ELIST_D2
45 .;
46 .S ERROR=0,GETDATA="" I $L(ELIST) D
47 ..N NDX
48 ..S:'(ELIST[U) ELIST=ELIST_U
49 ..;
50 ..I $L(ELIST),DFLD,($$GETDTYP(+DFLD)="DATE/TIME") S GETDATA="$$INT2DT($$GETDATA(DFN,"""_ELIST_""","_DFLD_"),0)"
51 ..E I $L(ELIST),DFLD,($$GETDTYP(+DFLD)="BOOLEAN") S GETDATA="$S($$GETDATA(DFN,"""_ELIST_""","_DFLD_"):""TRUE"",1:""FALSE"")"
52 ..E I $L(ELIST),DFLD S GETDATA="$$GETDATA(DFN,"""_ELIST_""","_DFLD_")"
53 .I '$L(GETDATA) S ERROR=1 Q
54 .S MSG=$P(MSG,"|",1,PIEC-1)_"|"_GETDATA_"|"_$P(MSG,"|",PIEC+1,99)
55 ;
56 I 'OCXDTCD D
57 .S:'($E(MSG,1)="|") MSG=""""_MSG
58 .S:($E(MSG,1)="|") MSG=$E(MSG,2,$L(MSG))
59 .S:'($E(MSG,$L(MSG))="|") MSG=MSG_""""
60 .S:($E(MSG,$L(MSG))="|") MSG=$E(MSG,1,$L(MSG)-1)
61 .F Q:'(MSG["||") S MSG=$P(MSG,"||",1)_"_"_$P(MSG,"||",2,999)
62 .F Q:'(MSG["|") D
63 ..N MSG1,MSG2 S MSG1=$P(MSG,"|",1),MSG2=$P(MSG,"|",2)
64 ..I ($E(MSG1,$L(MSG1))=")") S MSG=MSG1_"_"""_$P(MSG,"|",2,999)
65 ..I ($E(MSG2,1)="$") S MSG=$P(MSG,"|",1)_"""_"_$P(MSG,"|",2,999)
66 ;
67 I OCXDTCD S MSG=$TR(MSG,"|","")
68 ;
69 Q MSG
70 K D0,D1
71 ;
72GETDTYP(OCXDF) ;
73 ;
74 N OCXLINK,OCXATT,OCXCON,OCXDTYP
75 Q:'$G(OCXDF) ""
76 S OCXDTYP="",OCXCON=0 F S OCXCON=$O(^OCXS(860.4,+OCXDF,"LINK",OCXCON)) Q:'OCXCON D Q:$L(OCXDTYP)
77 .S OCXLINK=$G(^OCXS(860.4,+OCXDF,"LINK",OCXCON,"DATAPATH")) Q:'$L(OCXLINK) ""
78 .S OCXLINK=$O(^OCXS(863.3,"B",OCXLINK,0)) Q:'OCXLINK ""
79 .S OCXATT=$P($G(^OCXS(863.3,OCXLINK,0)),U,5) Q:'OCXATT ""
80 .S OCXDTYP=$$GETPARM(34,OCXATT,"DATA TYPE")
81 Q OCXDTYP
82 ;
83GETPARM(FILE,INST,PARM) ;
84 Q:'$L(FILE) "" Q:'$L(INST) "" Q:'$L(PARM) ""
85 N OCXP,OCXP1,OCXI,OCXGL
86 S OCXGL="^OCXS" S:(FILE=1) OCXGL="^OCXD" S:(FILE=7) OCXGL="^OCXD" S:(FILE=10) OCXGL="^OCXD" S FILE=FILE/10+860
87 Q:'$D(@OCXGL@(+FILE,0)) ""
88 I (PARM=+PARM),$D(^OCXS(863.8,PARM,0)) S OCXP=PARM
89 E S OCXP=$O(^OCXS(863.8,"B",PARM,0))
90 Q:'OCXP ""
91 I (INST=+INST),$D(@OCXGL@(FILE,INST,0)) S OCXI=INST
92 E S OCXI=$O(@OCXGL@(FILE,"B",INST,0))
93 Q:'OCXI "" S OCXP1=$O(@OCXGL@(FILE,OCXI,"PAR","B",OCXP,0)) Q:'OCXP1 ""
94 Q $G(@OCXGL@(FILE,OCXI,"PAR",OCXP1,"VAL"))
95 ;
96GETDF(FNAM) ;
97 ;
98 S FNUM=$O(^OCXS(860.4,"C",FNAM,0))
99 I 'FNUM S FNUM=0 F S FNUM=$O(^OCXS(860.4,"B",$E(FNAM,1,30),0)) Q:'FNUM Q:($P($G(^OCXS(860.4,FNUM,0)),U,1)=FNAM)
100 Q +FNUM
Note: See TracBrowser for help on using the repository browser.