[623] | 1 | OCXSEND ;SLC/RJS,CLA - BUILD RULE TRANSPORTER ROUTINES ;2/01/01 10:10
|
---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,74,96,105**;Dec 17,1997
|
---|
| 3 | ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
|
---|
| 4 | ;
|
---|
| 5 | S ;
|
---|
| 6 | N X,IOP,TOTL S TOTL=0
|
---|
| 7 | N CVER,RCNT,RSIZE,LASTFILE,HEADER1,HEADER2,HEADER3,HEADER4,HEADER5
|
---|
| 8 | N OCXASK,OCXID,OCXLIN2,OCXLIN3,OCXPATCH,OCXSCR,PARM,PARMV,DIE,DIERR,DIQ2,FCPARM,TEXT
|
---|
| 9 | I '$D(IOM) S IOP=0 D ^%ZIS K IOP
|
---|
| 10 | K ^TMP("OCXSEND",$J),^UTILITY($J),OCXPATH
|
---|
| 11 | K ^UTILITY($J),OCXPATH
|
---|
| 12 | S ^TMP("OCXSEND",$J)=($P($H,",",2)+($H*86400)+(4*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
|
---|
| 13 | S OCXLIN2=$T(+2)
|
---|
| 14 | S OCXLIN3=$T(+3)
|
---|
| 15 | ;
|
---|
| 16 | D ^OCXSEND1 ; Get List of Objects to Transport
|
---|
| 17 | ;
|
---|
| 18 | I '$O(^TMP("OCXSEND",$J,"LIST",0)) K ^TMP("OCXSEND",$J) Q ; Nothing selected so Quit
|
---|
| 19 | ;
|
---|
| 20 | S OCXASK="" F D Q:$L(OCXASK)
|
---|
| 21 | .W !
|
---|
| 22 | .W !,"When the transport routine encounters locally"
|
---|
| 23 | .W !,"altered rule data at a site, do you want to:"
|
---|
| 24 | .;
|
---|
| 25 | .S OCXASK=$$READ("S^O:Overwrite local data;D:Display locally altered data only;A:Ask the site what to do","(O)verwrite, (D)isplay, or (A)sk the site ? ","Ask")
|
---|
| 26 | ;
|
---|
| 27 | Q:(OCXASK[U)
|
---|
| 28 | I (OCXASK="O") W !!,"Locally altered data will be overwritten without asking.",!!
|
---|
| 29 | I (OCXASK="D") W !!,"Locally altered data will be displayed only.",!!
|
---|
| 30 | I (OCXASK="A") W !!,"Sites will be asked before locally altered data is overwritten.",!!
|
---|
| 31 | ;
|
---|
| 32 | S OCXPATCH="" F D Q:$L(OCXPATCH)
|
---|
| 33 | .W !!,"Enter Patch ID (ex. OR*3*96): " R OCXPATCH:DTIME E S OCXPATCH="^" Q
|
---|
| 34 | .Q:(OCXPATCH="^")
|
---|
| 35 | .I '$L(OCXPATCH) S OCXPATCH="^^" Q
|
---|
| 36 | .I $L(OCXPATCH),'(OCXPATCH?1"OR*"1N1"*"1.4N) D S OCXPATCH="" Q
|
---|
| 37 | ..W !!
|
---|
| 38 | ..W:'(OCXPATCH["?") "Invalid"
|
---|
| 39 | ..W " Format -> OR*v*ppp"
|
---|
| 40 | ..W !," v = Package Version."
|
---|
| 41 | ..W !," ppp = Patch Number."
|
---|
| 42 | ..W !
|
---|
| 43 | Q:(OCXPATCH="^")
|
---|
| 44 | S:(OCXPATCH="^^") OCXPATCH=""
|
---|
| 45 | I $P(OCXPATCH,"*",3) S $P(OCXLIN2,";",5)="**"_$P(OCXPATCH,"*",3)_"**"
|
---|
| 46 | I $L(OCXPATCH) S OCXPATCH="(Delete after Install of "_OCXPATCH_")"
|
---|
| 47 | ;
|
---|
| 48 | Q:'$$RSDEL
|
---|
| 49 | ;
|
---|
| 50 | D ^OCXSEND2 ; Get File Data
|
---|
| 51 | ;
|
---|
| 52 | S TOTL=$$EN^OCXSEND3 ; File Routines
|
---|
| 53 | ;
|
---|
| 54 | S TOTL=TOTL+$$EN^OCXSENDA ; File Main Runtime Library Routine
|
---|
| 55 | ;
|
---|
| 56 | S TOTL=TOTL+$$EN^OCXSEND4 ; File Utility Runtime Library Routine 0
|
---|
| 57 | ;
|
---|
| 58 | S TOTL=TOTL+$$EN^OCXSEND5 ; File Utility Runtime Library Routine 1
|
---|
| 59 | ;
|
---|
| 60 | S TOTL=TOTL+$$EN^OCXSEND6 ; File Utility Runtime Library Routine 2
|
---|
| 61 | ;
|
---|
| 62 | S TOTL=TOTL+$$EN^OCXSEND7 ; File Utility Runtime Library Routine 3
|
---|
| 63 | ;
|
---|
| 64 | S TOTL=TOTL+$$EN^OCXSEND8 ; File Utility Runtime Library Routine 4
|
---|
| 65 | ;
|
---|
| 66 | EXIT K ^TMP("OCXSEND",$J),^UTILITY($J)
|
---|
| 67 | ;
|
---|
| 68 | W !!,TOTL," total lines of code filed.",!!
|
---|
| 69 | ;
|
---|
| 70 | Q
|
---|
| 71 | ;
|
---|
| 72 | READ(OCX0,OCXA,OCXB,OCXL) ;
|
---|
| 73 | N X,DIR,DTOUT,DUOUT,DIRUT,DIROUT
|
---|
| 74 | Q:'$L($G(OCX0)) U
|
---|
| 75 | S DIR(0)=OCX0
|
---|
| 76 | S:$L($G(OCXA)) DIR("A")=OCXA
|
---|
| 77 | S:$L($G(OCXB)) DIR("B")=OCXB
|
---|
| 78 | F X=1:1:($G(OCXL)-1) W !
|
---|
| 79 | D ^DIR
|
---|
| 80 | I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q U
|
---|
| 81 | Q Y
|
---|
| 82 | ;
|
---|
| 83 | CUCI() Q:'$D(^%ZOSF("UCI")) "" N Y X ^%ZOSF("UCI") Q Y
|
---|
| 84 | ;
|
---|
| 85 | NETNAME() ;
|
---|
| 86 | Q:$L($G(^XMB("NETNAME"))) ^XMB("NETNAME")
|
---|
| 87 | Q:$L($G(^XMB("NAME"))) ^XMB("NAME")
|
---|
| 88 | Q $$CUCI
|
---|
| 89 | ;
|
---|
| 90 | RSDEL() ;
|
---|
| 91 | ;
|
---|
| 92 | W !!,"Scanning for old rule transport routines..."
|
---|
| 93 | N X,CNT,RCNT,RLIST,RNAME
|
---|
| 94 | S RCNT=0
|
---|
| 95 | ;
|
---|
| 96 | ; Scan for Routines To Delete
|
---|
| 97 | ;
|
---|
| 98 | ; Main Routine
|
---|
| 99 | S RNAME=$$RNAME^OCXSEND3(0,0) I $$RFIND(RNAME,100) S RLIST(RNAME)=""
|
---|
| 100 | ;
|
---|
| 101 | ; Runtime Library routines
|
---|
| 102 | F CNT=0:1:35 S RNAME=$$RNAME^OCXSEND3(CNT,1) I $$RFIND(RNAME,CNT) S RLIST(RNAME)=""
|
---|
| 103 | ;
|
---|
| 104 | ; Data Routines
|
---|
| 105 | F CNT=0:1:46655 S RNAME=$$RNAME^OCXSEND3(CNT,2) I $$RFIND(RNAME,CNT) S RLIST(RNAME)=""
|
---|
| 106 | ;
|
---|
| 107 | I '$L($O(RLIST(""))) W !,"No old rule transport routines found..." H 2 Q 1
|
---|
| 108 | ;
|
---|
| 109 | W !!,"These routines will be deleted and overwritten."
|
---|
| 110 | Q:'$$READ("Y"," Do you want to proceed?","NO") 0
|
---|
| 111 | ;
|
---|
| 112 | ; Delete The routines
|
---|
| 113 | ;
|
---|
| 114 | I '$D(^%ZOSF("DEL")) W !!,"Old rule transport routines not deleted (^%ZOSF(""DEL"") undefined)" Q 0
|
---|
| 115 | ;
|
---|
| 116 | S RNAME="" F RCNT=1:1 S RNAME=$O(RLIST(RNAME)) Q:'$L(RNAME) D
|
---|
| 117 | .W !,RNAME
|
---|
| 118 | .I $$RDEL(RNAME) W " Deleted..." Q
|
---|
| 119 | .W " Not Deleted..."
|
---|
| 120 | ;
|
---|
| 121 | W !!,RCNT," routine",$S((RCNT=1):"",1:"s")," deleted."
|
---|
| 122 | ;
|
---|
| 123 | H 2 Q 1
|
---|
| 124 | ;
|
---|
| 125 | RFIND(X,C) ;
|
---|
| 126 | W:($X>70) ! W:'(C#100) "."
|
---|
| 127 | Q:'$L(X) 0 X "S TEXT=$T(+1^"_X_")" Q:'$L(TEXT) 0
|
---|
| 128 | W !,X Q 1
|
---|
| 129 | Q
|
---|
| 130 | ;
|
---|
| 131 | RDEL(X) ;
|
---|
| 132 | ;
|
---|
| 133 | Q:'$L(X) 0 X "S TEXT=$T(+1^"_X_")" Q:'$L(TEXT) 0
|
---|
| 134 | X ^%ZOSF("DEL") Q 1
|
---|
| 135 | ;
|
---|