OCXRULE ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install of OR*3*96) ;JAN 30,2001 at 11:16
;;3.0;ORDER ENTRY/RESULTS REPORTING;**96**;Dec 17,1997
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
S ;
;
N OCXDIER,QUIT,LINE,TEXT,REMOTE,LOCAL,D0,OPCODE,REF,OCXFLAG S QUIT=0
N OCXAUTO,OCZSCR
;
D DOT
I $L($T(VERSION^OCXOCMP)),($$VERSION^OCXOCMP="ORDER CHECK EXPERT version 1.01 released OCT 29,1998"),1
E D Q
.W !
.W !,"Rule Transport aborted, version mismatch."
.W !,"Current Local version: ",$$VERSION^OCXOCMP
.W !," Rule Transport Version: ORDER CHECK EXPERT version 1.01 released OCT 29,1998"
I '$D(DTIME) W !!,"DTIME not defined !!",!! Q
W !!,"Order Check Expert System Rule Transporter"
W !," Created: JAN 30,2001 at 11:16 at DEVCUR.ISC-SLC.VA.GOV"
W !," Current Date: ",$$NOW^OCXRU0," at ",$$NETNAME^OCXSEND,!!
S LASTFILE=0 K ^TMP("OCXRULE",$J)
S ^TMP("OCXRULE",$J)=($P($H,",",2)+($H*86400)+(1*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
S OCXFLAG="O"
;
RUN ;
;
W !,"Loading Data " D ^OCXRU001
;
S LINE=0 F S LINE=$O(^TMP("OCXRULE",$J,LINE)) Q:'LINE D Q:QUIT
.D:'(LINE#50) STATUS^OCXOPOST(LINE,$O(^TMP("OCXRULE",$J," "),-1))
.S TEXT=$G(^TMP("OCXRULE",$J,LINE)) I $L(TEXT) D Q:QUIT
..S TEXT=$P(TEXT,";",2,999),OPCODE=$P(TEXT,U,1),TEXT=$P(TEXT,U,2,999)
..;
..I OPCODE="KEY" D DOT S LOCAL="",D0=$$GETFILE^OCXRU0(+$P(TEXT,U,1),$P(TEXT,U,2),.LOCAL) S QUIT=(D0=(-10)) Q
..I OPCODE="R" S REF="REMOTE("_$P(TEXT,":",1)_":"_D0_$P(TEXT,":",2,99)_")" Q
..I OPCODE="D",$D(REF) S @REF=$P(TEXT,U,1,999) K REF Q
..;
..I OPCODE="EOR" S QUIT=$$COMPARE^OCXRU1(.LOCAL,.REMOTE) K LOCAL,REMOTE Q
..I OPCODE="EOF" K LOCAL,REMOTE Q
..I OPCODE="SOF" W !," Installing '",TEXT,"' records... " Q
..I OPCODE="ROOT" D Q
...N FILE,DATA
...S FILE=U_$P(TEXT,U,1),DATA=$P(TEXT,U,2,3)
...Q:$D(@FILE)
...S @FILE=DATA
...W !," Restoring file #",(+$P(DATA,U,2))," zero node"
..;
..W !,"Unknown OpCode: ",OPCODE," in: ",TEXT S QUIT=$$PAUSE^OCXRU0 W !
;
K ^TMP("OCXRULE",$J)
;
I $D(^OCXS) D
.N FILE,DO,PD0,CNT
.S FILE=0 F S FILE=$O(^OCXS(FILE)) Q:'FILE D
..S D0=0 F CNT=0:1 S PD0=D0,D0=$O(^OCXS(FILE,D0)) Q:'D0
..S $P(^OCXS(FILE,0),U,3,4)=CNT_U_PD0
;
W !!,?5,+$G(OCXDIER)," data error",$S(($G(OCXDIER)=1):"",1:"s")
W !!,"Transport Finished..."
;
I '$G(ZTSK),($E($G(IOST),1,2)="C-") D I 1
.W !!,"These changes will not be implemented until the rules are recompiled."
.I $$READ("Y"," Do you want to recompile now ?","YES") D ^OCXOCMP
;
E D
.N OCXOETIM
.D BMES^XPDUTL("---Creating Order Check Routines-----------------------------------")
.D AUTO^OCXOCMP
;
Q
;
DOT Q:$G(OCXAUTO) W:($X>70) ! W " ." Q
;
READ(OCXZ0,OCXZA,OCXZB,OCXZL) ;
N OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
Q:'$L($G(OCXZ0)) U
S DIR(0)=OCXZ0
S:$L($G(OCXZA)) DIR("A")=OCXZA
S:$L($G(OCXZB)) DIR("B")=OCXZB
F OCXLINE=1:1:($G(OCXZL)-1) W !
D ^DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q U
Q Y
;
OCXRULE ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install of OR*3*96) ;JAN 30,2001 at 11:16
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**96**;Dec 17,1997
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
S ;
+1 ;
+2 NEW OCXDIER,QUIT,LINE,TEXT,REMOTE,LOCAL,D0,OPCODE,REF,OCXFLAG
SET QUIT=0
+3 NEW OCXAUTO,OCZSCR
+4 ;
+5 DO DOT
+6 IF $LENGTH($TEXT(VERSION^OCXOCMP))
IF ($$VERSION^OCXOCMP="ORDER CHECK EXPERT version 1.01 released OCT 29,1998")
IF 1
+7 IF '$TEST
Begin DoDot:1
+8 WRITE !
+9 WRITE !,"Rule Transport aborted, version mismatch."
+10 WRITE !,"Current Local version: ",$$VERSION^OCXOCMP
+11 WRITE !," Rule Transport Version: ORDER CHECK EXPERT version 1.01 released OCT 29,1998"
End DoDot:1
QUIT
+12 IF '$DATA(DTIME)
WRITE !!,"DTIME not defined !!",!!
QUIT
+13 WRITE !!,"Order Check Expert System Rule Transporter"
+14 WRITE !," Created: JAN 30,2001 at 11:16 at DEVCUR.ISC-SLC.VA.GOV"
+15 WRITE !," Current Date: ",$$NOW^OCXRU0," at ",$$NETNAME^OCXSEND,!!
+16 SET LASTFILE=0
KILL ^TMP("OCXRULE",$JOB)
+17 SET ^TMP("OCXRULE",$JOB)=($PIECE($HOROLOG,",",2)+($HOROLOG*86400)+(1*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
+18 SET OCXFLAG="O"
+19 ;
RUN ;
+1 ;
+2 WRITE !,"Loading Data "
DO ^OCXRU001
+3 ;
+4 SET LINE=0
FOR
SET LINE=$ORDER(^TMP("OCXRULE",$JOB,LINE))
IF 'LINE
QUIT
Begin DoDot:1
+5 IF '(LINE#50)
DO STATUS^OCXOPOST(LINE,$ORDER(^TMP("OCXRULE",$JOB," "),-1))
+6 SET TEXT=$GET(^TMP("OCXRULE",$JOB,LINE))
IF $LENGTH(TEXT)
Begin DoDot:2
+7 SET TEXT=$PIECE(TEXT,";",2,999)
SET OPCODE=$PIECE(TEXT,U,1)
SET TEXT=$PIECE(TEXT,U,2,999)
+8 ;
+9 IF OPCODE="KEY"
DO DOT
SET LOCAL=""
SET D0=$$GETFILE^OCXRU0(+$PIECE(TEXT,U,1),$PIECE(TEXT,U,2),.LOCAL)
SET QUIT=(D0=(-10))
QUIT
+10 IF OPCODE="R"
SET REF="REMOTE("_$PIECE(TEXT,":",1)_":"_D0_$PIECE(TEXT,":",2,99)_")"
QUIT
+11 IF OPCODE="D"
IF $DATA(REF)
SET @REF=$PIECE(TEXT,U,1,999)
KILL REF
QUIT
+12 ;
+13 IF OPCODE="EOR"
SET QUIT=$$COMPARE^OCXRU1(.LOCAL,.REMOTE)
KILL LOCAL,REMOTE
QUIT
+14 IF OPCODE="EOF"
KILL LOCAL,REMOTE
QUIT
+15 IF OPCODE="SOF"
WRITE !," Installing '",TEXT,"' records... "
QUIT
+16 IF OPCODE="ROOT"
Begin DoDot:3
+17 NEW FILE,DATA
+18 SET FILE=U_$PIECE(TEXT,U,1)
SET DATA=$PIECE(TEXT,U,2,3)
+19 IF $DATA(@FILE)
QUIT
+20 SET @FILE=DATA
+21 WRITE !," Restoring file #",(+$PIECE(DATA,U,2))," zero node"
End DoDot:3
QUIT
+22 ;
+23 WRITE !,"Unknown OpCode: ",OPCODE," in: ",TEXT
SET QUIT=$$PAUSE^OCXRU0
WRITE !
End DoDot:2
IF QUIT
QUIT
End DoDot:1
IF QUIT
QUIT
+24 ;
+25 KILL ^TMP("OCXRULE",$JOB)
+26 ;
+27 IF $DATA(^OCXS)
Begin DoDot:1
+28 NEW FILE,DO,PD0,CNT
+29 SET FILE=0
FOR
SET FILE=$ORDER(^OCXS(FILE))
IF 'FILE
QUIT
Begin DoDot:2
+30 SET D0=0
FOR CNT=0:1
SET PD0=D0
SET D0=$ORDER(^OCXS(FILE,D0))
IF 'D0
QUIT
+31 SET $PIECE(^OCXS(FILE,0),U,3,4)=CNT_U_PD0
End DoDot:2
End DoDot:1
+32 ;
+33 WRITE !!,?5,+$GET(OCXDIER)," data error",$SELECT(($GET(OCXDIER)=1):"",1:"s")
+34 WRITE !!,"Transport Finished..."
+35 ;
+36 IF '$GET(ZTSK)
IF ($EXTRACT($GET(IOST),1,2)="C-")
Begin DoDot:1
+37 WRITE !!,"These changes will not be implemented until the rules are recompiled."
+38 IF $$READ("Y"," Do you want to recompile now ?","YES")
DO ^OCXOCMP
End DoDot:1
IF 1
+39 ;
+40 IF '$TEST
Begin DoDot:1
+41 NEW OCXOETIM
+42 DO BMES^XPDUTL("---Creating Order Check Routines-----------------------------------")
+43 DO AUTO^OCXOCMP
End DoDot:1
+44 ;
+45 QUIT
+46 ;
DOT IF $GET(OCXAUTO)
QUIT
IF ($X>70)
WRITE !
WRITE " ."
QUIT
+1 ;
READ(OCXZ0,OCXZA,OCXZB,OCXZL) ;
+1 NEW OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
+2 IF '$LENGTH($GET(OCXZ0))
QUIT U
+3 SET DIR(0)=OCXZ0
+4 IF $LENGTH($GET(OCXZA))
SET DIR("A")=OCXZA
+5 IF $LENGTH($GET(OCXZB))
SET DIR("B")=OCXZB
+6 FOR OCXLINE=1:1:($GET(OCXZL)-1)
WRITE !
+7 DO ^DIR
+8 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
QUIT U
+9 QUIT Y
+10 ;
