Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: OCXOCMP4

OCXOCMP4.m

Go to the documentation of this file. 
  1. OCXOCMP4 ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Sort Code Segments) ;1/05/04  14:38
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221**;Dec 17,1997
  1.  ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
  1.  ;
  1. EN() ;
  1.  ;
  1.  Q:$G(OCXWARN) OCXWARN
  1.  N OCXD0,OCXD1,OCXD2,OCXD3,OCXD4,OCXU
  1.  S OCXU="UPDATE"
  1.  Q:'$$LINE("LOG","-") 1
  1.  Q:'$$LINE("CDATA","-") 1
  1.  Q:'$$LINE(OCXU,"DFN","OCXSRC","OUTMSG") 1
  1.  Q:'$$LINE("SCAN") 1
  1.  Q:'$$LINE("TERM","OCXTERM","OCXLIST") 1
  1.  ;
  1.  D SWAP^OCXOCMPH
  1.  ;
  1.  D TERM^OCXOCMPU
  1.  ;
  1.  D IN("LOG"," Q "_(+OCXDLOG))
  1.  D IN("CDATA"," Q """_(+OCXTRACE)_U_(+OCXTLOG)_U_(+OCXDLOG)_"""")
  1.  ;
  1.  I OCXTLOG D
  1.  .D IN(OCXU," S OCXOTIME=$$TIMELOG(""O"",""UPDATE^OCXOZ01"")")
  1.  .D IN(OCXU," ;")
  1.  ;
  1.  D IN(OCXU," K ^TMP(""OCXCHK"",$J)")
  1.  D IN(OCXU," S ^TMP(""OCXCHK"",$J)=($P($H,"","",2)+($H*86400)+(2*60))_"" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG""")
  1.  I '(OCXTLOG) D IN(OCXU," N OCXOERR,OCXOCMSG,OCXNDX,OCXDF,OCXX,OCXTSPI")
  1.  I (OCXTLOG) D IN(OCXU," N OCXOERR,OCXOCMSG,OCXNDX,OCXDF,OCXX,OCXTSPI,OCXBOOLV")
  1.  D IN(OCXU," S OCXTSPI="_+$G(OCXTSPI))
  1.  I $G(OCXTRACE) D
  1.  .D IN(OCXU," I $G(OCXTRACE),'$G(DFN) W !,""Patient not defined !""")
  1.  .D IN(OCXU," I $G(OCXTRACE),$G(DFN) W !,||LNTAG||,?30,""Data Field: Patient: ("",DFN,"") "",$P($G(^DPT(DFN,0)),""^"",1),"" !""")
  1.  I 'OCXTLOG D IN(OCXU," Q:'$G(DFN)")
  1.  I OCXTLOG D IN(OCXU," I '$G(DFN) S OCXOTIME=$$TIMELOG(""I"",""UPDATE^OCXOZ01"") Q")
  1.  D IN("SCAN"," ;")
  1.  D IN("SCAN"," N OCXD0,OCXRULE S OCXD0=0 F  S OCXD0=$O(^TMP(""OCXCHK"",$J,DFN,OCXD0)) Q:'OCXD0  D")
  1.  D IN("SCAN"," .Q:'($G(^TMP(""OCXCHK"",$J,DFN,OCXD0))=1)")
  1.  D IN("SCAN"," .N OCXPGM S OCXPGM=$O(^OCXS(860.3,""APGM"",OCXD0,"""")) Q:'$L(OCXPGM)  X ""I $L($T(""_OCXPGM_""))"" E  Q")
  1.  D IN("SCAN"," .D @OCXPGM")
  1.  D IN("SCAN"," .S ^TMP(""OCXCHK"",$J,DFN,OCXD0)=$G(^TMP(""OCXCHK"",$J,DFN,OCXD0))+10")
  1.  D IN("SCAN"," K ^TMP(""OCXCHK"",$J)")
  1.  ;
  1.  S OCXCOD0=0 F  S OCXCOD0=$O(^TMP("OCXCMP",$J,"A CODE",OCXCOD0)) Q:'OCXCOD0  D  Q:OCXWARN
  1.  .S OCXD1=0 F  S OCXD1=$O(^TMP("OCXCMP",$J,"A CODE",OCXCOD0,OCXD1)) Q:'OCXD1  S OCXCODE=$G(^(OCXD1)) I $L(OCXCODE) D
  1.  ..I '$G(OCXAUTO) W:($X>60) ! W "."
  1.  ..Q:(OCXCODE["OCXBOOLV")
  1.  ..S OCXD2=OCXD1 F  S OCXD2=$O(^TMP("OCXCMP",$J,"A CODE",OCXCOD0,OCXD2)) Q:'OCXD2  D
  1.  ...I (OCXCODE=$G(^TMP("OCXCMP",$J,"A CODE",OCXCOD0,OCXD2))) K ^TMP("OCXCMP",$J,"A CODE",OCXCOD0,OCXD2)
  1.  ;
  1.  I $G(OCXTRACE) D
  1.  .D IN(OCXU," ;")
  1.  .D IN(OCXU," I $G(OCXTRACE) D")
  1.  .D IN(OCXU," .W !,||LNTAG||,?30,""Data Source: "",$G(OCXOSRC)")
  1.  .;S CONTXT=$O(^OCXS(860.6,"B","DATABASE LOOKUP",0)) Q:'CONTXT 0
  1.  .S OCXD0="" F  S OCXD0=$O(^TMP("OCXCMP",$J,"DATA FIELD TRACE",OCXD0)) Q:'$L(OCXD0)  D
  1.  ..N OCXTRLN,OCXTRSR
  1.  ..S OCXTRLN="TRACE"_OCXD0,OCXTRSR=$$LINE(OCXTRLN) Q:'OCXTRSR
  1.  ..I ($P($G(^OCXS(860.6,+OCXD0,0)),U,1)="DATABASE LOOKUP") D IN(OCXU," .D ||LINE:"_OCXTRSR_"||") I 1
  1.  ..E  D IN(OCXU," .I ($G(OCXOSRC)="""_$P($G(^OCXS(860.6,+OCXD0,0)),U,1)_""") D ||LINE:"_OCXTRSR_"||")
  1.  ..S OCXD1="" F  S OCXD1=$O(^TMP("OCXCMP",$J,"DATA FIELD TRACE",OCXD0,OCXD1)) Q:'$L(OCXD1)  D
  1.  ...S OCXD2="" F  S OCXD2=$O(^TMP("OCXCMP",$J,"DATA FIELD TRACE",OCXD0,OCXD1,OCXD2)) Q:'$L(OCXD2)  D
  1.  ....S OCXD3="" F  S OCXD3=$O(^TMP("OCXCMP",$J,"DATA FIELD TRACE",OCXD0,OCXD1,OCXD2,OCXD3)) Q:'$L(OCXD3)  D
  1.  .....S OCXD4="" F  S OCXD4=$O(^TMP("OCXCMP",$J,"DATA FIELD TRACE",OCXD0,OCXD1,OCXD2,OCXD3,OCXD4)) Q:'$L(OCXD4)  D
  1.  ......D IN(OCXTRLN," "_^TMP("OCXCMP",$J,"DATA FIELD TRACE",OCXD0,OCXD1,OCXD2,OCXD3,OCXD4))
  1.  .D IN(OCXU," ;")
  1.  ;
  1.  S OCXD0=$$LINE("GETDF")
  1.  S OCXD1=$$LINE("SWAPOUT")
  1.  D IN(OCXU," I ($G(OCXOSRC)=""GENERIC HL7 MESSAGE ARRAY"") D ||LINE:"_OCXD0_"||,||LINE:"_OCXD1_"||(""OCXODATA"",.OCXODATA)","Y")
  1.  ;
  1.  S OCXCOD0=0 F  S OCXCOD0=$O(^TMP("OCXCMP",$J,"A CODE",OCXCOD0)) Q:'OCXCOD0  D  Q:OCXWARN
  1.  .N OCXCODE,OCXLIST
  1.  .S (OCXPAR,OCXD1)=0,OCXLLAB=OCXU
  1.  .F  S OCXD1=$O(^TMP("OCXCMP",$J,"A CODE",OCXCOD0,OCXD1)) Q:'OCXD1  S OCXCODE=$G(^(OCXD1)),OCXLIST=$G(^(OCXD1,"OPLIST")) I $L(OCXCODE) D
  1.  ..I '$G(OCXAUTO) W:($X>60) ! W "."
  1.  ..S OCXD2=$$CODELKUP(OCXPAR,OCXCODE)
  1.  ..I 'OCXD2 D
  1.  ...S OCXD2=$O(^TMP("OCXCMP",$J,"B CODE",OCXPAR,99999),-1)+1
  1.  ...S ^TMP("OCXCMP",$J,"B CODE",OCXPAR,"B",$E(OCXCODE,1,50),OCXD2)=OCXCODE
  1.  ...S OCXNPAR=$O(^TMP("OCXCMP",$J,"B CODE",99999),-1)+1
  1.  ...I ($O(^TMP("OCXCMP",$J,"A CODE",OCXCOD0,OCXD1))) S OCXCODE=OCXCODE_" D ||LINE:"_$$LINE("CHK"_OCXNPAR)_"||" S:$L(OCXLIST) OCXLIST=OCXLIST_"D"
  1.  ...D IN(OCXLLAB," "_OCXCODE,OCXLIST,16000)
  1.  ...S ^TMP("OCXCMP",$J,"B CODE",OCXPAR,OCXD2,"PAR")=OCXNPAR
  1.  ...S ^TMP("OCXCMP",$J,"B CODE",OCXPAR,OCXD2)=OCXCODE
  1.  ...S:$L(OCXLIST) ^TMP("OCXCMP",$J,"B CODE",OCXPAR,OCXD2,"OPLIST")=OCXLIST
  1.  ..S OCXPAR=$G(^TMP("OCXCMP",$J,"B CODE",OCXPAR,OCXD2,"PAR"))
  1.  ..S OCXLLAB="CHK"_OCXPAR
  1.  ;
  1.  S OCXWARN=$$EN^OCXOCMPD
  1.  ;
  1.  D IN(OCXU," ;","Y",18000)
  1.  D IN(OCXU," D ||LINE:"_$$LINE("SCAN")_"||","Y",18000)
  1.  D IN(OCXU," ;","Y",18000)
  1.  D IN(OCXU," I $O(OCXOCMSG("""")) D","Y",18000)
  1.  D IN(OCXU," .N OCXNDX1,OCXNDX2","Y",18000)
  1.  D IN(OCXU," .S OCXNDX1=0 F  S OCXNDX1=$O(OCXOCMSG(OCXNDX1)) Q:'OCXNDX1  D","Y",18000)
  1.  D IN(OCXU," ..S OCXNDX2=0 F  S OCXNDX2=$O(OUTMSG(OCXNDX2)) Q:'OCXNDX2  Q:(OUTMSG(OCXNDX2)=OCXOCMSG(OCXNDX1))","Y",18000)
  1.  D IN(OCXU," ..Q:OCXNDX2  S OUTMSG($O(OUTMSG(999999),-1)+1)=OCXOCMSG(OCXNDX1)","Y",18000)
  1.  D IN(OCXU," K ^TMP(""OCXCHK"",$J)","Y",18000)
  1.  I OCXTLOG D IN(OCXU," S OCXOTIME=$$TIMELOG(""I"",""UPDATE^OCXOZ01"")","Y",18000)
  1.  ;
  1.  D IN(OCXU," ;","Y",18000)
  1.  S OCXD0=$$LINE("SWAPIN")
  1.  D IN(OCXU," I ($G(OCXOSRC)=""GENERIC HL7 MESSAGE ARRAY"") K OCXDF D ||LINE:"_OCXD0_"||(""OCXODATA"",.OCXODATA)","Y",18000)
  1.  ;
  1.  Q OCXWARN
  1.  ;
  1. CODELKUP(OCXP,OCXC) ;
  1.  ;
  1.  N OCXD0
  1.  S OCXD0=0 F  S OCXD0=$O(^TMP("OCXCMP",$J,"B CODE",OCXP,"B",$E(OCXC,1,50),OCXD0))  Q:'OCXD0  Q:(OCXC=^(OCXD0))
  1.  Q +OCXD0
  1.  ;
  1. IN(LINE,CODE,OPLIST,STRT) ;
  1.  ;
  1.  N INDEX,NEXTLN
  1.  S STRT=+$G(STRT,13000),INDEX=$$LINE(LINE)
  1.  F NEXTLN=STRT:1 Q:'$D(^TMP("OCXCMP",$J,"C CODE",INDEX,NEXTLN))
  1.  S ^TMP("OCXCMP",$J,"C CODE",INDEX,NEXTLN,0)=CODE
  1.  S:$L($G(OPLIST)) ^TMP("OCXCMP",$J,"C CODE",INDEX,NEXTLN,"OPLIST")=OPLIST
  1.  ;
  1.  Q
  1.  ;
  1. LINE(X,ARG1,ARG2,ARG3,ARG4) ;
  1.  ;
  1.  N Y S Y=+$G(^TMP("OCXCMP",$J,"LINE","B",X)) Q:Y +Y
  1.  ;
  1.  Q +$$NEWLINE(X,$G(ARG1),$G(ARG2),$G(ARG3),$G(ARG4))
  1.  ;
  1. NEWLINE(X,ARG1,ARG2,ARG3,ARG4) ;
  1.  ;
  1.  N Y,REC
  1.  S Y=0
  1.  I ($E(X,1,3)="LOG") S Y=1
  1.  E  I ($E(X,1,5)="CDATA") S Y=2
  1.  E  I ($E(X,1,6)="UPDATE") S Y=3
  1.  E  I (X="SWAPIN") S Y=10
  1.  E  I (X="SWAPOUT") S Y=10
  1.  E  I ($E(X,1,5)="GETDF") S Y=10
  1.  E  I ($E(X,1,4)="SCAN") S Y=20
  1.  E  I ($E(X,1,5)="TRACE") S Y=30
  1.  E  I ($E(X,1,8)="TERM") S Y=40
  1.  E  D
  1.  .I ($E(X,1,3)="CHK") S Y=100000
  1.  .I ($E(X,1,2)="EL") S Y=200000
  1.  .I ($E(X,1)="R") S Y=300000
  1.  F Y=Y:1 Q:'$D(^TMP("OCXCMP",$J,"LINE",Y))
  1.  S ^TMP("OCXCMP",$J,"LINE",+Y)=X
  1.  S ^TMP("OCXCMP",$J,"LINE","B",X)=+Y
  1.  S REC(10000,0)=X_" ;"
  1.  I $L($G(ARG1)) S REC(10000,0)=X_"("_$S(ARG1="-":"",1:ARG1)_") ;"
  1.  I $L($G(ARG1)),$L($G(ARG2)) S REC(10000,0)=X_"("_ARG1_","_ARG2_") ;"
  1.  I $L($G(ARG1)),$L($G(ARG2)),$L($G(ARG3)) S REC(10000,0)=X_"("_ARG1_","_ARG2_","_ARG3_") ;"
  1.  I $L($G(ARG1)),$L($G(ARG2)),$L($G(ARG3)),$L($G(ARG4)) S REC(10000,0)=X_"("_ARG1_","_ARG2_","_ARG3_","_ARG4_") ;"
  1.  ;
  1.  S REC(10001,0)=" ;",REC(10002,0)=" ;"
  1.  I '(X["UPDATE"),'(X["LOG"),'(X["CDATA") S REC(10003,0)=" Q:$G(OCXOERR)"
  1.  ;
  1.  I $G(OCXTRACE) D
  1.  .S:(X["UPDATE") REC(10004,0)=" W:$G(OCXTRACE) !!,""**********************************************************"",!,||LNTAG||,?25,""Execution trace. """
  1.  .S:'(X["UPDATE") REC(10004,0)=" W:$G(OCXTRACE) !,||LNTAG||,?25,""Execution trace. "",$P($T("_X_"+1),"";"",2)"
  1.  ;
  1.  I OCXTLOG,'(X["UPDATE"),'(X["LOG") S REC(10005,0)=" S OCXERR=$$TIMELOG(""M"",""Line: "_X_U_"""_$P($T(+1),"" "",1))"
  1.  ;
  1.  I '(X["LOG"),'(X["CDATA") S REC(11000,0)=" ;",REC(19998,0)=" Q"
  1.  S REC(19999,0)=" ;"
  1.  M ^TMP("OCXCMP",$J,"C CODE",+Y)=REC
  1.  Q (+Y)
  1.  K ARG1,ARG2
  1.  ;