OCXOCMPQ ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Sort Code Segments cont...) ;3/21/01 10:17
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
;
TIME(T,OCXD0,OCXD1) ;
;
N TIME
S TIME=""
I (T["|") D
.N DAY,OPER,OFFS
.I ($E(T,1)="|") S DAY=$P(T,"|",2) I $L(DAY) S DAY=$$DFLKUP(DAY) I DAY S DAY="|"_$P(T,"|",2)_"|"
.E Q
.S OPER=$P($P(T,"|",3)," ",2) I '(OPER="+"),'(OPER="-") Q
.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
.S TIME=$$XLATE(DAY,OCXD0,OCXD1)_","""_OPER_""","""_OFFS_""""
I '(T["|") D
.N DAY,OPER,OFFS
.S DAY=$P(T," ",1) I '(DAY="TODAY"),'(DAY="NOW") Q
.S OPER=$P(T," ",2) I '(OPER="+"),'(OPER="-") Q
.S OFFS=$P(T," ",3) I '(OFFS?1.N1"H"),'(OFFS?1.N1"D"),'(OFFS?1.N1"W"),'(OFFS?1.N1"M") Q
.S TIME=""""_$E(DAY,1)_""","""_OPER_""","""_OFFS_""""
Q TIME
;
DFLKUP(X) ;
N XL,Y
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)
Q Y
;
XLATE(MSG,D0,D1,OCXDTCD) ;
;
N PIEC,ERROR S ERROR=0
S OCXDTCD=+$G(OCXDTCD)
I (MSG["|") S:('$L(MSG,"|")#2) MSG=MSG_"|" F PIEC=2:2:$L(MSG,"|") D Q:ERROR
.N FLD,ELIST,LABEL,D2,DFLD,TEMP
.S FLD=$P(MSG,"|",PIEC),(DFLD,ELIST)=0,GETDATA=""
.I (FLD[".") D I 1
..S LABEL=$P(FLD,".",1),DFLD=$P(FLD,".",2),D2=0
..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))
..S:D2 ELIST=+$P($G(^OCXS(860.2,D0,"C",D2,0)),U,2)
..S:$L(DFLD) DFLD=$$GETDF(DFLD)
.E D
..S ELIST="" S:$L(FLD) DFLD=$$GETDF(FLD) Q:'DFLD
..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
.;
.S ERROR=0,GETDATA="" I $L(ELIST) D
..N NDX
..S:'(ELIST[U) ELIST=ELIST_U
..;
..I $L(ELIST),DFLD,($$GETDTYP(+DFLD)="DATE/TIME") S GETDATA="$$INT2DT($$GETDATA(DFN,"""_ELIST_""","_DFLD_"),0)"
..E I $L(ELIST),DFLD,($$GETDTYP(+DFLD)="BOOLEAN") S GETDATA="$S($$GETDATA(DFN,"""_ELIST_""","_DFLD_"):""TRUE"",1:""FALSE"")"
..E I $L(ELIST),DFLD S GETDATA="$$GETDATA(DFN,"""_ELIST_""","_DFLD_")"
.I '$L(GETDATA) S ERROR=1 Q
.S MSG=$P(MSG,"|",1,PIEC-1)_"|"_GETDATA_"|"_$P(MSG,"|",PIEC+1,99)
;
I 'OCXDTCD D
.S:'($E(MSG,1)="|") MSG=""""_MSG
.S:($E(MSG,1)="|") MSG=$E(MSG,2,$L(MSG))
.S:'($E(MSG,$L(MSG))="|") MSG=MSG_""""
.S:($E(MSG,$L(MSG))="|") MSG=$E(MSG,1,$L(MSG)-1)
.F Q:'(MSG["||") S MSG=$P(MSG,"||",1)_"_"_$P(MSG,"||",2,999)
.F Q:'(MSG["|") D
..N MSG1,MSG2 S MSG1=$P(MSG,"|",1),MSG2=$P(MSG,"|",2)
..I ($E(MSG1,$L(MSG1))=")") S MSG=MSG1_"_"""_$P(MSG,"|",2,999)
..I ($E(MSG2,1)="$") S MSG=$P(MSG,"|",1)_"""_"_$P(MSG,"|",2,999)
;
I OCXDTCD S MSG=$TR(MSG,"|","")
;
Q MSG
K D0,D1
;
GETDTYP(OCXDF) ;
;
N OCXLINK,OCXATT,OCXCON,OCXDTYP
Q:'$G(OCXDF) ""
S OCXDTYP="",OCXCON=0 F S OCXCON=$O(^OCXS(860.4,+OCXDF,"LINK",OCXCON)) Q:'OCXCON D Q:$L(OCXDTYP)
.S OCXLINK=$G(^OCXS(860.4,+OCXDF,"LINK",OCXCON,"DATAPATH")) Q:'$L(OCXLINK) ""
.S OCXLINK=$O(^OCXS(863.3,"B",OCXLINK,0)) Q:'OCXLINK ""
.S OCXATT=$P($G(^OCXS(863.3,OCXLINK,0)),U,5) Q:'OCXATT ""
.S OCXDTYP=$$GETPARM(34,OCXATT,"DATA TYPE")
Q OCXDTYP
;
GETPARM(FILE,INST,PARM) ;
Q:'$L(FILE) "" Q:'$L(INST) "" Q:'$L(PARM) ""
N OCXP,OCXP1,OCXI,OCXGL
S OCXGL="^OCXS" S:(FILE=1) OCXGL="^OCXD" S:(FILE=7) OCXGL="^OCXD" S:(FILE=10) OCXGL="^OCXD" S FILE=FILE/10+860
Q:'$D(@OCXGL@(+FILE,0)) ""
I (PARM=+PARM),$D(^OCXS(863.8,PARM,0)) S OCXP=PARM
E S OCXP=$O(^OCXS(863.8,"B",PARM,0))
Q:'OCXP ""
I (INST=+INST),$D(@OCXGL@(FILE,INST,0)) S OCXI=INST
E S OCXI=$O(@OCXGL@(FILE,"B",INST,0))
Q:'OCXI "" S OCXP1=$O(@OCXGL@(FILE,OCXI,"PAR","B",OCXP,0)) Q:'OCXP1 ""
Q $G(@OCXGL@(FILE,OCXI,"PAR",OCXP1,"VAL"))
;
GETDF(FNAM) ;
;
S FNUM=$O(^OCXS(860.4,"C",FNAM,0))
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)
Q +FNUM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXOCMPQ 3972 printed Dec 13, 2024@02:25:02 Page 2
OCXOCMPQ ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Sort Code Segments cont...) ;3/21/01 10:17
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
+4 ;
TIME(T,OCXD0,OCXD1) ;
+1 ;
+2 NEW TIME
+3 SET TIME=""
+4 IF (T["|")
Begin DoDot:1
+5 NEW DAY,OPER,OFFS
+6 IF ($EXTRACT(T,1)="|")
SET DAY=$PIECE(T,"|",2)
IF $LENGTH(DAY)
SET DAY=$$DFLKUP(DAY)
IF DAY
SET DAY="|"_$PIECE(T,"|",2)_"|"
+7 IF '$TEST
QUIT
+8 SET OPER=$PIECE($PIECE(T,"|",3)," ",2)
IF '(OPER="+")
IF '(OPER="-")
QUIT
+9 SET OFFS=$PIECE($PIECE(T,"|",3)," ",3)
IF '(OFFS?1.N1"H")
IF '(OFFS?1.N1"D")
IF '(OFFS?1.N1"W")
IF '(OFFS?1.N1"M")
QUIT
+10 SET TIME=$$XLATE(DAY,OCXD0,OCXD1)_","""_OPER_""","""_OFFS_""""
End DoDot:1
+11 IF '(T["|")
Begin DoDot:1
+12 NEW DAY,OPER,OFFS
+13 SET DAY=$PIECE(T," ",1)
IF '(DAY="TODAY")
IF '(DAY="NOW")
QUIT
+14 SET OPER=$PIECE(T," ",2)
IF '(OPER="+")
IF '(OPER="-")
QUIT
+15 SET OFFS=$PIECE(T," ",3)
IF '(OFFS?1.N1"H")
IF '(OFFS?1.N1"D")
IF '(OFFS?1.N1"W")
IF '(OFFS?1.N1"M")
QUIT
+16 SET TIME=""""_$EXTRACT(DAY,1)_""","""_OPER_""","""_OFFS_""""
End DoDot:1
+17 QUIT TIME
+18 ;
DFLKUP(X) ;
+1 NEW XL,Y
+2 SET Y=0
FOR XL=$LENGTH(X):-1:1
if Y
QUIT
SET Y=0
FOR
SET Y=$ORDER(^OCXS(860.4,"B",$EXTRACT(X,1,XL),Y))
if 'Y
QUIT
if ($PIECE($GET(^OCXS(860.4,Y,0)),U,1)=X)
QUIT
+3 QUIT Y
+4 ;
XLATE(MSG,D0,D1,OCXDTCD) ;
+1 ;
+2 NEW PIEC,ERROR
SET ERROR=0
+3 SET OCXDTCD=+$GET(OCXDTCD)
+4 IF (MSG["|")
if ('$LENGTH(MSG,"|")#2)
SET MSG=MSG_"|"
FOR PIEC=2:2:$LENGTH(MSG,"|")
Begin DoDot:1
+5 NEW FLD,ELIST,LABEL,D2,DFLD,TEMP
+6 SET FLD=$PIECE(MSG,"|",PIEC)
SET (DFLD,ELIST)=0
SET GETDATA=""
+7 IF (FLD[".")
Begin DoDot:2
+8 SET LABEL=$PIECE(FLD,".",1)
SET DFLD=$PIECE(FLD,".",2)
SET D2=0
+9 IF $LENGTH(LABEL)
SET D2=$ORDER(^OCXS(860.2,D0,"C","B",LABEL,0))
if 'D2
SET D2=$ORDER(^OCXS(860.2,D0,"C","C",LABEL,0))
+10 if D2
SET ELIST=+$PIECE($GET(^OCXS(860.2,D0,"C",D2,0)),U,2)
+11 if $LENGTH(DFLD)
SET DFLD=$$GETDF(DFLD)
End DoDot:2
IF 1
+12 IF '$TEST
Begin DoDot:2
+13 SET ELIST=""
if $LENGTH(FLD)
SET DFLD=$$GETDF(FLD)
if 'DFLD
QUIT
+14 SET D2=0
FOR
SET D2=$ORDER(^TMP("OCXCMP",$JOB,"RULE",D0,D1,D2))
if 'D2
QUIT
if $LENGTH(ELIST)
SET ELIST=ELIST_U
SET ELIST=ELIST_D2
End DoDot:2
+15 ;
+16 SET ERROR=0
SET GETDATA=""
IF $LENGTH(ELIST)
Begin DoDot:2
+17 NEW NDX
+18 if '(ELIST[U)
SET ELIST=ELIST_U
+19 ;
+20 IF $LENGTH(ELIST)
IF DFLD
IF ($$GETDTYP(+DFLD)="DATE/TIME")
SET GETDATA="$$INT2DT($$GETDATA(DFN,"""_ELIST_""","_DFLD_"),0)"
+21 IF '$TEST
IF $LENGTH(ELIST)
IF DFLD
IF ($$GETDTYP(+DFLD)="BOOLEAN")
SET GETDATA="$S($$GETDATA(DFN,"""_ELIST_""","_DFLD_"):""TRUE"",1:""FALSE"")"
+22 IF '$TEST
IF $LENGTH(ELIST)
IF DFLD
SET GETDATA="$$GETDATA(DFN,"""_ELIST_""","_DFLD_")"
End DoDot:2
+23 IF '$LENGTH(GETDATA)
SET ERROR=1
QUIT
+24 SET MSG=$PIECE(MSG,"|",1,PIEC-1)_"|"_GETDATA_"|"_$PIECE(MSG,"|",PIEC+1,99)
End DoDot:1
if ERROR
QUIT
+25 ;
+26 IF 'OCXDTCD
Begin DoDot:1
+27 if '($EXTRACT(MSG,1)="|")
SET MSG=""""_MSG
+28 if ($EXTRACT(MSG,1)="|")
SET MSG=$EXTRACT(MSG,2,$LENGTH(MSG))
+29 if '($EXTRACT(MSG,$LENGTH(MSG))="|")
SET MSG=MSG_""""
+30 if ($EXTRACT(MSG,$LENGTH(MSG))="|")
SET MSG=$EXTRACT(MSG,1,$LENGTH(MSG)-1)
+31 FOR
if '(MSG["||")
QUIT
SET MSG=$PIECE(MSG,"||",1)_"_"_$PIECE(MSG,"||",2,999)
+32 FOR
if '(MSG["|")
QUIT
Begin DoDot:2
+33 NEW MSG1,MSG2
SET MSG1=$PIECE(MSG,"|",1)
SET MSG2=$PIECE(MSG,"|",2)
+34 IF ($EXTRACT(MSG1,$LENGTH(MSG1))=")")
SET MSG=MSG1_"_"""_$PIECE(MSG,"|",2,999)
+35 IF ($EXTRACT(MSG2,1)="$")
SET MSG=$PIECE(MSG,"|",1)_"""_"_$PIECE(MSG,"|",2,999)
End DoDot:2
End DoDot:1
+36 ;
+37 IF OCXDTCD
SET MSG=$TRANSLATE(MSG,"|","")
+38 ;
+39 QUIT MSG
+40 KILL D0,D1
+41 ;
GETDTYP(OCXDF) ;
+1 ;
+2 NEW OCXLINK,OCXATT,OCXCON,OCXDTYP
+3 if '$GET(OCXDF)
QUIT ""
+4 SET OCXDTYP=""
SET OCXCON=0
FOR
SET OCXCON=$ORDER(^OCXS(860.4,+OCXDF,"LINK",OCXCON))
if 'OCXCON
QUIT
Begin DoDot:1
+5 SET OCXLINK=$GET(^OCXS(860.4,+OCXDF,"LINK",OCXCON,"DATAPATH"))
if '$LENGTH(OCXLINK)
QUIT ""
+6 SET OCXLINK=$ORDER(^OCXS(863.3,"B",OCXLINK,0))
if 'OCXLINK
QUIT ""
+7 SET OCXATT=$PIECE($GET(^OCXS(863.3,OCXLINK,0)),U,5)
if 'OCXATT
QUIT ""
+8 SET OCXDTYP=$$GETPARM(34,OCXATT,"DATA TYPE")
End DoDot:1
if $LENGTH(OCXDTYP)
QUIT
+9 QUIT OCXDTYP
+10 ;
GETPARM(FILE,INST,PARM) ;
+1 if '$LENGTH(FILE)
QUIT ""
if '$LENGTH(INST)
QUIT ""
if '$LENGTH(PARM)
QUIT ""
+2 NEW OCXP,OCXP1,OCXI,OCXGL
+3 SET OCXGL="^OCXS"
if (FILE=1)
SET OCXGL="^OCXD"
if (FILE=7)
SET OCXGL="^OCXD"
if (FILE=10)
SET OCXGL="^OCXD"
SET FILE=FILE/10+860
+4 if '$DATA(@OCXGL@(+FILE,0))
QUIT ""
+5 IF (PARM=+PARM)
IF $DATA(^OCXS(863.8,PARM,0))
SET OCXP=PARM
+6 IF '$TEST
SET OCXP=$ORDER(^OCXS(863.8,"B",PARM,0))
+7 if 'OCXP
QUIT ""
+8 IF (INST=+INST)
IF $DATA(@OCXGL@(FILE,INST,0))
SET OCXI=INST
+9 IF '$TEST
SET OCXI=$ORDER(@OCXGL@(FILE,"B",INST,0))
+10 if 'OCXI
QUIT ""
SET OCXP1=$ORDER(@OCXGL@(FILE,OCXI,"PAR","B",OCXP,0))
if 'OCXP1
QUIT ""
+11 QUIT $GET(@OCXGL@(FILE,OCXI,"PAR",OCXP1,"VAL"))
+12 ;
GETDF(FNAM) ;
+1 ;
+2 SET FNUM=$ORDER(^OCXS(860.4,"C",FNAM,0))
+3 IF 'FNUM
SET FNUM=0
FOR
SET FNUM=$ORDER(^OCXS(860.4,"B",$EXTRACT(FNAM,1,30),0))
if 'FNUM
QUIT
if ($PIECE($GET(^OCXS(860.4,FNUM,0)),U,1)=FNAM)
QUIT
+4 QUIT +FNUM
