[613] | 1 | OCXOCMPQ ;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 | ;
|
---|
| 6 | TIME(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 | ;
|
---|
| 25 | DFLKUP(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 | ;
|
---|
| 30 | XLATE(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 | ;
|
---|
| 72 | GETDTYP(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 | ;
|
---|
| 83 | GETPARM(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 | ;
|
---|
| 96 | GETDF(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
|
---|