source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORY144ES.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1ORY144ES ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install of OR*3*144) ;JUN 12,2002 at 12:20
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**144**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5S ;
6 ;
7 N OCXDIER,QUIT,LINE,TEXT,REMOTE,LOCAL,D0,OPCODE,REF,OCXFLAG S QUIT=0
8 N OCXAUTO,OCZSCR
9 ;
10 D DOT
11 I $L($T(VERSION^OCXOCMP)),($$VERSION^OCXOCMP="ORDER CHECK EXPERT version 1.01 released OCT 29,1998"),1
12 E D Q
13 .W !
14 .W !,"Rule Transport aborted, version mismatch."
15 .W !,"Current Local version: ",$$VERSION^OCXOCMP
16 .W !," Rule Transport Version: ORDER CHECK EXPERT version 1.01 released OCT 29,1998"
17 I '$D(DTIME) W !!,"DTIME not defined !!",!! Q
18 W !!,"Order Check Expert System Rule Transporter"
19 W !," Created: JUN 12,2002 at 12:20 at DEVCUR.FO-SLC.MED.VA.GOV"
20 W !," Current Date: ",$$NOW^ORY1440," at ",$$NETNAME^OCXSEND,!!
21 S LASTFILE=0 K ^TMP("OCXRULE",$J)
22 S ^TMP("OCXRULE",$J)=($P($H,",",2)+($H*86400)+(1*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
23 S OCXFLAG="O"
24 ;
25RUN ;
26 ;
27 W !,"Loading Data " D ^ORY14401
28 ;
29 S LINE=0 F S LINE=$O(^TMP("OCXRULE",$J,LINE)) Q:'LINE D Q:QUIT
30 .D:'(LINE#50) STATUS^OCXOPOST(LINE,$O(^TMP("OCXRULE",$J," "),-1))
31 .S TEXT=$G(^TMP("OCXRULE",$J,LINE)) I $L(TEXT) D Q:QUIT
32 ..S TEXT=$P(TEXT,";",2,999),OPCODE=$P(TEXT,U,1),TEXT=$P(TEXT,U,2,999)
33 ..;
34 ..I OPCODE="KEY" D DOT S LOCAL="",D0=$$GETFILE^ORY1440(+$P(TEXT,U,1),$P(TEXT,U,2),.LOCAL) S QUIT=(D0=(-10)) Q
35 ..I OPCODE="R" S REF="REMOTE("_$P(TEXT,":",1)_":"_D0_$P(TEXT,":",2,99)_")" Q
36 ..I OPCODE="D",$D(REF) S @REF=$P(TEXT,U,1,999) K REF Q
37 ..;
38 ..I OPCODE="EOR" S QUIT=$$COMPARE^ORY1441(.LOCAL,.REMOTE) K LOCAL,REMOTE Q
39 ..I OPCODE="EOF" K LOCAL,REMOTE Q
40 ..I OPCODE="SOF" W !," Installing '",TEXT,"' records... " Q
41 ..I OPCODE="ROOT" D Q
42 ...N FILE,DATA
43 ...S FILE=U_$P(TEXT,U,1),DATA=$P(TEXT,U,2,3)
44 ...I ($P($G(@FILE),U,1,2)=DATA) Q
45 ...S $P(@FILE,U,1,2)=DATA
46 ...W !," Restoring file #",(+$P(DATA,U,2))," zero node"
47 ..;
48 ..W !,"Unknown OpCode: ",OPCODE," in: ",TEXT S QUIT=$$PAUSE^ORY1440 W !
49 ;
50 K ^TMP("OCXRULE",$J)
51 ;
52 I $D(^OCXS) D
53 .N FILE,DO,PD0,CNT
54 .S FILE=0 F S FILE=$O(^OCXS(FILE)) Q:'FILE D
55 ..S D0=0 F CNT=0:1 S PD0=D0,D0=$O(^OCXS(FILE,D0)) Q:'D0
56 ..S $P(^OCXS(FILE,0),U,3,4)=CNT_U_PD0
57 ;
58 I $G(OCXDIER) D
59 .W !!!!!!!
60 .W !,?5,"******************** Warning ******************** "
61 .W !,?7,+$G(OCXDIER)," data filing error",$S(($G(OCXDIER)=1):"",1:"s"),"."
62 .W !,?7,"Some expert system rules may be incomplete."
63 .W !,?5,"******************** Warning ******************** "
64 I '$G(OCXDIER) W !!,?5," No data filing errors."
65 W !!,"Transport Finished..."
66 ;
67 D
68 .N OCXOETIM
69 .D BMES^XPDUTL("---Creating Order Check Routines-----------------------------------")
70 .D AUTO^OCXOCMP
71 ;
72 Q
73 ;
74DOT Q:$G(OCXAUTO) W:($X>70) ! W " ." Q
75 ;
76READ(OCXZ0,OCXZA,OCXZB,OCXZL) ;
77 N OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
78 Q:'$L($G(OCXZ0)) U
79 S DIR(0)=OCXZ0
80 S:$L($G(OCXZA)) DIR("A")=OCXZA
81 S:$L($G(OCXZB)) DIR("B")=OCXZB
82 F OCXLINE=1:1:($G(OCXZL)-1) W !
83 D ^DIR
84 I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q U
85 Q Y
86 ;
Note: See TracBrowser for help on using the repository browser.