OCXSEND ;SLC/RJS,CLA - BUILD RULE TRANSPORTER ROUTINES ;2/22/08 12:30
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,74,96,105,243**;Dec 17,1997;Build 242
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
S ;
N X,IOP,TOTL S TOTL=0
N CVER,RCNT,RSIZE,LASTFILE,HEADER1,HEADER2,HEADER3,HEADER4,HEADER5
N OCXASK,OCXID,OCXLIN2,OCXLIN3,OCXPATCH,OCXSCR,PARM,PARMV,DIE,DIERR,DIQ2,FCPARM,TEXT
I '$D(IOM) S IOP=0 D ^%ZIS K IOP
K ^TMP("OCXSEND",$J),^UTILITY($J),OCXPATH
K ^UTILITY($J),OCXPATH
S ^TMP("OCXSEND",$J)=($P($H,",",2)+($H*86400)+(4*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
S OCXLIN2=$T(+2)
S OCXLIN3=$T(+3)
;
D ^OCXSEND1 ; Get List of Objects to Transport
;
I '$O(^TMP("OCXSEND",$J,"LIST",0)) K ^TMP("OCXSEND",$J) Q ; Nothing selected so Quit
;
S OCXASK="" F D Q:$L(OCXASK)
.W !
.W !,"When the transport routine encounters locally"
.W !,"altered rule data at a site, do you want to:"
.;
.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")
;
Q:(OCXASK[U)
I (OCXASK="O") W !!,"Locally altered data will be overwritten without asking.",!!
I (OCXASK="D") W !!,"Locally altered data will be displayed only.",!!
I (OCXASK="A") W !!,"Sites will be asked before locally altered data is overwritten.",!!
;
S OCXPATCH="" F D Q:$L(OCXPATCH)
.W !!,"Enter Patch ID (ex. OR*3*96): " R OCXPATCH:DTIME E S OCXPATCH="^" Q
.Q:(OCXPATCH="^")
.I '$L(OCXPATCH) S OCXPATCH="^^" Q
.I $L(OCXPATCH),'(OCXPATCH?1"OR*"1N1"*"1.4N) D S OCXPATCH="" Q
..W !!
..W:'(OCXPATCH["?") "Invalid"
..W " Format -> OR*v*ppp"
..W !," v = Package Version."
..W !," ppp = Patch Number."
..W !
Q:(OCXPATCH="^")
S:(OCXPATCH="^^") OCXPATCH=""
I $P(OCXPATCH,"*",3) S $P(OCXLIN2,";",5)="**"_$P(OCXPATCH,"*",3)_"**"
I $L(OCXPATCH) S OCXPATCH="(Delete after Install of "_OCXPATCH_")"
;
Q:'$$RSDEL
;
D ^OCXSEND2 ; Get File Data
;
S TOTL=$$EN^OCXSEND3 ; File Routines
;
S TOTL=TOTL+$$EN^OCXSENDA ; File Main Runtime Library Routine
;
S TOTL=TOTL+$$EN^OCXSEND4 ; File Utility Runtime Library Routine 0
;
S TOTL=TOTL+$$EN^OCXSEND5 ; File Utility Runtime Library Routine 1
;
S TOTL=TOTL+$$EN^OCXSEND6 ; File Utility Runtime Library Routine 2
;
S TOTL=TOTL+$$EN^OCXSEND7 ; File Utility Runtime Library Routine 3
;
S TOTL=TOTL+$$EN^OCXSEND8 ; File Utility Runtime Library Routine 4
;
EXIT K ^TMP("OCXSEND",$J),^UTILITY($J)
;
W !!,"Routines filed.",!!
;
Q
;
READ(OCX0,OCXA,OCXB,OCXL) ;
N X,DIR,DTOUT,DUOUT,DIRUT,DIROUT
Q:'$L($G(OCX0)) U
S DIR(0)=OCX0
S:$L($G(OCXA)) DIR("A")=OCXA
S:$L($G(OCXB)) DIR("B")=OCXB
F X=1:1:($G(OCXL)-1) W !
D ^DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q U
Q Y
;
CUCI() Q:'$D(^%ZOSF("UCI")) "" N Y X ^%ZOSF("UCI") Q Y
;
NETNAME() ;
N NETNAME
S NETNAME=$P($$NETNAME^XMXUTIL(DUZ),"@",2)
I $L(NETNAME) Q NETNAME
; Q:$L($G(^XMB("NETNAME"))) ^XMB("NETNAME")
; Q:$L($G(^XMB("NAME"))) ^XMB("NAME")
Q $$CUCI
;
RSDEL() ;
;
W !!,"Scanning for old rule transport routines..."
N X,CNT,RCNT,RLIST,RNAME
S RCNT=0
;
; Scan for Routines To Delete
;
; Main Routine
S RNAME=$$RNAME^OCXSEND3(0,0) I $$RFIND(RNAME,100) S RLIST(RNAME)=""
;
; Runtime Library routines
F CNT=0:1:35 S RNAME=$$RNAME^OCXSEND3(CNT,1) I $$RFIND(RNAME,CNT) S RLIST(RNAME)=""
;
; Data Routines
F CNT=0:1:46655 S RNAME=$$RNAME^OCXSEND3(CNT,2) I $$RFIND(RNAME,CNT) S RLIST(RNAME)=""
;
I '$L($O(RLIST(""))) W !,"No old rule transport routines found..." H 2 Q 1
;
W !!,"These routines will be deleted and overwritten."
Q:'$$READ("Y"," Do you want to proceed?","NO") 0
;
; Delete The routines
;
I '$D(^%ZOSF("DEL")) W !!,"Old rule transport routines not deleted (^%ZOSF(""DEL"") undefined)" Q 0
;
S RNAME="" F RCNT=1:1 S RNAME=$O(RLIST(RNAME)) Q:'$L(RNAME) D
.W !,RNAME
.I $$RDEL(RNAME) W " Deleted..." Q
.W " Not Deleted..."
;
W !!,RCNT," routine",$S((RCNT=1):"",1:"s")," deleted."
;
H 2 Q 1
;
RFIND(X,C) ;
W:($X>70) ! W:'(C#100) "."
Q:'$L(X) 0 X "S TEXT=$T(+1^"_X_")" Q:'$L(TEXT) 0
W !,X Q 1
Q
;
RDEL(X) ;
;
Q:'$L(X) 0 X "S TEXT=$T(+1^"_X_")" Q:'$L(TEXT) 0
X ^%ZOSF("DEL") Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXSEND 4313 printed Dec 13, 2024@02:26:25 Page 2
OCXSEND ;SLC/RJS,CLA - BUILD RULE TRANSPORTER ROUTINES ;2/22/08 12:30
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,74,96,105,243**;Dec 17,1997;Build 242
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
S ;
+1 NEW X,IOP,TOTL
SET TOTL=0
+2 NEW CVER,RCNT,RSIZE,LASTFILE,HEADER1,HEADER2,HEADER3,HEADER4,HEADER5
+3 NEW OCXASK,OCXID,OCXLIN2,OCXLIN3,OCXPATCH,OCXSCR,PARM,PARMV,DIE,DIERR,DIQ2,FCPARM,TEXT
+4 IF '$DATA(IOM)
SET IOP=0
DO ^%ZIS
KILL IOP
+5 KILL ^TMP("OCXSEND",$JOB),^UTILITY($JOB),OCXPATH
+6 KILL ^UTILITY($JOB),OCXPATH
+7 SET ^TMP("OCXSEND",$JOB)=($PIECE($HOROLOG,",",2)+($HOROLOG*86400)+(4*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
+8 SET OCXLIN2=$TEXT(+2)
+9 SET OCXLIN3=$TEXT(+3)
+10 ;
+11 ; Get List of Objects to Transport
DO ^OCXSEND1
+12 ;
+13 ; Nothing selected so Quit
IF '$ORDER(^TMP("OCXSEND",$JOB,"LIST",0))
KILL ^TMP("OCXSEND",$JOB)
QUIT
+14 ;
+15 SET OCXASK=""
FOR
Begin DoDot:1
+16 WRITE !
+17 WRITE !,"When the transport routine encounters locally"
+18 WRITE !,"altered rule data at a site, do you want to:"
+19 ;
+20 SET 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")
End DoDot:1
if $LENGTH(OCXASK)
QUIT
+21 ;
+22 if (OCXASK[U)
QUIT
+23 IF (OCXASK="O")
WRITE !!,"Locally altered data will be overwritten without asking.",!!
+24 IF (OCXASK="D")
WRITE !!,"Locally altered data will be displayed only.",!!
+25 IF (OCXASK="A")
WRITE !!,"Sites will be asked before locally altered data is overwritten.",!!
+26 ;
+27 SET OCXPATCH=""
FOR
Begin DoDot:1
+28 WRITE !!,"Enter Patch ID (ex. OR*3*96): "
READ OCXPATCH:DTIME
IF '$TEST
SET OCXPATCH="^"
QUIT
+29 if (OCXPATCH="^")
QUIT
+30 IF '$LENGTH(OCXPATCH)
SET OCXPATCH="^^"
QUIT
+31 IF $LENGTH(OCXPATCH)
IF '(OCXPATCH?1"OR*"1N1"*"1.4N)
Begin DoDot:2
+32 WRITE !!
+33 if '(OCXPATCH["?")
WRITE "Invalid"
+34 WRITE " Format -> OR*v*ppp"
+35 WRITE !," v = Package Version."
+36 WRITE !," ppp = Patch Number."
+37 WRITE !
End DoDot:2
SET OCXPATCH=""
QUIT
End DoDot:1
if $LENGTH(OCXPATCH)
QUIT
+38 if (OCXPATCH="^")
QUIT
+39 if (OCXPATCH="^^")
SET OCXPATCH=""
+40 IF $PIECE(OCXPATCH,"*",3)
SET $PIECE(OCXLIN2,";",5)="**"_$PIECE(OCXPATCH,"*",3)_"**"
+41 IF $LENGTH(OCXPATCH)
SET OCXPATCH="(Delete after Install of "_OCXPATCH_")"
+42 ;
+43 if '$$RSDEL
QUIT
+44 ;
+45 ; Get File Data
DO ^OCXSEND2
+46 ;
+47 ; File Routines
SET TOTL=$$EN^OCXSEND3
+48 ;
+49 ; File Main Runtime Library Routine
SET TOTL=TOTL+$$EN^OCXSENDA
+50 ;
+51 ; File Utility Runtime Library Routine 0
SET TOTL=TOTL+$$EN^OCXSEND4
+52 ;
+53 ; File Utility Runtime Library Routine 1
SET TOTL=TOTL+$$EN^OCXSEND5
+54 ;
+55 ; File Utility Runtime Library Routine 2
SET TOTL=TOTL+$$EN^OCXSEND6
+56 ;
+57 ; File Utility Runtime Library Routine 3
SET TOTL=TOTL+$$EN^OCXSEND7
+58 ;
+59 ; File Utility Runtime Library Routine 4
SET TOTL=TOTL+$$EN^OCXSEND8
+60 ;
EXIT KILL ^TMP("OCXSEND",$JOB),^UTILITY($JOB)
+1 ;
+2 WRITE !!,"Routines filed.",!!
+3 ;
+4 QUIT
+5 ;
READ(OCX0,OCXA,OCXB,OCXL) ;
+1 NEW X,DIR,DTOUT,DUOUT,DIRUT,DIROUT
+2 if '$LENGTH($GET(OCX0))
QUIT U
+3 SET DIR(0)=OCX0
+4 if $LENGTH($GET(OCXA))
SET DIR("A")=OCXA
+5 if $LENGTH($GET(OCXB))
SET DIR("B")=OCXB
+6 FOR X=1:1:($GET(OCXL)-1)
WRITE !
+7 DO ^DIR
+8 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
QUIT U
+9 QUIT Y
+10 ;
CUCI() if '$DATA(^%ZOSF("UCI"))
QUIT ""
NEW Y
XECUTE ^%ZOSF("UCI")
QUIT Y
+1 ;
NETNAME() ;
+1 NEW NETNAME
+2 SET NETNAME=$PIECE($$NETNAME^XMXUTIL(DUZ),"@",2)
+3 IF $LENGTH(NETNAME)
QUIT NETNAME
+4 ; Q:$L($G(^XMB("NETNAME"))) ^XMB("NETNAME")
+5 ; Q:$L($G(^XMB("NAME"))) ^XMB("NAME")
+6 QUIT $$CUCI
+7 ;
RSDEL() ;
+1 ;
+2 WRITE !!,"Scanning for old rule transport routines..."
+3 NEW X,CNT,RCNT,RLIST,RNAME
+4 SET RCNT=0
+5 ;
+6 ; Scan for Routines To Delete
+7 ;
+8 ; Main Routine
+9 SET RNAME=$$RNAME^OCXSEND3(0,0)
IF $$RFIND(RNAME,100)
SET RLIST(RNAME)=""
+10 ;
+11 ; Runtime Library routines
+12 FOR CNT=0:1:35
SET RNAME=$$RNAME^OCXSEND3(CNT,1)
IF $$RFIND(RNAME,CNT)
SET RLIST(RNAME)=""
+13 ;
+14 ; Data Routines
+15 FOR CNT=0:1:46655
SET RNAME=$$RNAME^OCXSEND3(CNT,2)
IF $$RFIND(RNAME,CNT)
SET RLIST(RNAME)=""
+16 ;
+17 IF '$LENGTH($ORDER(RLIST("")))
WRITE !,"No old rule transport routines found..."
HANG 2
QUIT 1
+18 ;
+19 WRITE !!,"These routines will be deleted and overwritten."
+20 if '$$READ("Y"," Do you want to proceed?","NO")
QUIT 0
+21 ;
+22 ; Delete The routines
+23 ;
+24 IF '$DATA(^%ZOSF("DEL"))
WRITE !!,"Old rule transport routines not deleted (^%ZOSF(""DEL"") undefined)"
QUIT 0
+25 ;
+26 SET RNAME=""
FOR RCNT=1:1
SET RNAME=$ORDER(RLIST(RNAME))
if '$LENGTH(RNAME)
QUIT
Begin DoDot:1
+27 WRITE !,RNAME
+28 IF $$RDEL(RNAME)
WRITE " Deleted..."
QUIT
+29 WRITE " Not Deleted..."
End DoDot:1
+30 ;
+31 WRITE !!,RCNT," routine",$SELECT((RCNT=1):"",1:"s")," deleted."
+32 ;
+33 HANG 2
QUIT 1
+34 ;
RFIND(X,C) ;
+1 if ($X>70)
WRITE !
if '(C#100)
WRITE "."
+2 if '$LENGTH(X)
QUIT 0
XECUTE "S TEXT=$T(+1^"_X_")"
if '$LENGTH(TEXT)
QUIT 0
+3 WRITE !,X
QUIT 1
+4 QUIT
+5 ;
RDEL(X) ;
+1 ;
+2 if '$LENGTH(X)
QUIT 0
XECUTE "S TEXT=$T(+1^"_X_")"
if '$LENGTH(TEXT)
QUIT 0
+3 XECUTE ^%ZOSF("DEL")
QUIT 1
+4 ;
