- 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 Jan 18, 2025@03:27:36 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 ;