source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOCMPQ.m@ 978

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