RTUTL5 ;TROY ISC/MJK-Re-Compile Templates DONT MAP; ; 4/13/87 3:22 PM ;
;;v 2.0;Record Tracking;;10/22/91
; ******* DO NOT MAP THIS ROUTINE *******
RECOMP ;Entry point to re-compile templates; RTFILE optionally defined
S U="^" S:'$D(RTFILE) RTFILE="^DIE(" D EQUALS^RTUTL3 W !?20,"Recompilation of '"_$S(RTFILE["DIPT":"OUTPUT",RTFILE["DIE":"INPUT",1:"CROSS-REFERENCES")_$S(RTFILE["DD(":"",1:"' Templates") D EQUALS^RTUTL3
I RTFILE'["DD(" S RTX="RT " F RTI=1:1 S RTX=$O(@(RTFILE_"""B"",RTX)")) Q:RTX=""!($E(RTX,1,3)'="RT ") S Y=+$O(^(RTX,0)) I Y>0,$D(@(RTFILE_"+Y,""ROUOLD"")")),^("ROUOLD")]"",$D(^(0)) S (RTEMP,Y)=+Y,X=$P(^("ROUOLD"),"^"),RT0=^(0) D COMP
XX I RTFILE["DD(",$D(@RTFILE) S (RT0,X)=^("DIK"),Y=+$P(RTFILE,"DD(",2) D COMP
Q
K RT0,RTX,RTI,RTEMP,RTFILE,RTI Q
Q ;
COMP W !,"---- RE-COMPILING THE '",$P(RT0,"^"),"' "_$S(RTFILE["DIPT":"OUTPUT",RTFILE["DIE":"INPUT",1:"CROSS-REFERENCE")_" TEMPLATES"
S DMAX=4000 D @($S(RTFILE["DIPT":"EN^DIPZ",RTFILE["DIE":"EN^DIEZ",1:"EN^DIKZ")) I RTFILE'["DD(",$D(@(RTFILE_RTEMP_",""ROU"")")) W !!?3,"...'",$P(RT0,"^"),"' has been re-compiled in the ",^("ROU"),"* routines." D EQUALS^RTUTL3
XZ I RTFILE["DD(",$D(@(RTFILE)) W !!?3,"...'",$P(RT0,"^"),"' has been re-compiled in the ",^("DIK"),"* routines." D EQUALS^RTUTL3
Q
;
BOTH S U="^",RTRD(1)="Yes^re-compile templates",RTRD(2)="No^not re-compile templates",RTRD("B")=2,RTRD(0)="S",RTRD("A")="Are you sure you want to re-compile the record tracking templates? " D SET^RTRD K RTRD Q:$E(X)'="Y"
S RTFILE="^DIE(" D RECOMP W !!
S RTFILE="^DIPT(" D RECOMP W !!
XR S RTK="0,"_"""DIK"""_")"
S RTFILE="^DD(190,"_RTK D RECOMP W !!
S RTFILE="^DD(190.1,"_RTK D XX W !!
S RTFILE="^DD(190.3,"_RTK D XX W !!
S RTFILE="^DD(194.2,"_RTK D XX W !!
S RTFILE="^DD(195.9,"_RTK D XX W !!
SDB ;
W !!,"Recompiling the Clinic Setup Template, don't worry"
S Y=$O(^DIE("B","SDB",0)) Q:'Y I $D(^DIE(Y,"ROUOLD")) S X=^("ROUOLD") I X="SDBT" S DMAX=4000 D EN^DIEZ
W "...Done.",!!,"NOTE: Recompilation should be performed on ALL systems."
K A,C,L,O,X1,DQ,DIE,DMAX,DIEZ,DIEZDUP,DK,DR
K X,RTX,RTK,RTI,RTFILE,RTEMP,RT0,J
Q
;
FRCHK I '$D(^%ZIS(1,"B",X)) K X Q
;naked ref to %ZIS(1,"B",,n) and %ZIS(1,n,"SUBTYPE")
I '$D(^%ZIS(1,+$O(^(X,0)),0))!('$D(^("SUBTYPE"))) K X Q
;naked ref to the %ZIS(1,n,"SUBTYPE")
I '$D(^%ZIS(2,+^("SUBTYPE"),0)) K X Q
;naked ref to %ZIS(2,n,0)
I $E(^(0))'="C" K X Q
Q:'$D(^RTV(195.9,"ADEV",X)) S X1=+$O(^(X,0)) Q:D0=X1
I $D(^RTV(195.9,X1,0)) S X1=^(0) W !?5,*7,"...device is already assigned to ",$S($D(^SC(+X1,0)):$P(^(0),"^"),1:"UNKNOWN"),!?10," of the ",$S($D(^DIC(195.1,+$P(X1,"^",3),0)):$P(^(0),"^"),1:"UNKNOWN")," application." K X,X1
Q
;
HELP ;Executeable Help for INPUT DEVICES multiple in file 195.9
W !!?3,"Device Name",?45,"Location",!?3,"-----------",?45,"--------"
S RTC=0,RTI="" F RTI1=0:0 S RTI=$O(^%ZIS(1,"B",RTI)) Q:RTI="" S RTX=+$O(^(RTI,0)) I $D(^%ZIS(1,RTX,0)),$D(^("SUBTYPE")),$D(^%ZIS(2,+^("SUBTYPE"),0)),$E(^(0))="C" D HELP1 Q:$D(RTESC)
K RTX,RTI,RTI1,RTC,RTESC Q
HELP1 S RTC=RTC+1 D ESC^RTRD:'(RTC#20) Q:$D(RTESC)
S RTX=^%ZIS(1,RTX,0) W !?3,$P(RTX,"^"),$S($P(RTX,"^",9)]"":" ["_$P(RTX,"^",9)_"]",1:"") W:$D(^(1)) ?45,$P(^(1),"^") Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTUTL5 3238 printed Dec 13, 2024@02:35:10 Page 2
RTUTL5 ;TROY ISC/MJK-Re-Compile Templates DONT MAP; ; 4/13/87 3:22 PM ;
+1 ;;v 2.0;Record Tracking;;10/22/91
+2 ; ******* DO NOT MAP THIS ROUTINE *******
RECOMP ;Entry point to re-compile templates; RTFILE optionally defined
+1 SET U="^"
if '$DATA(RTFILE)
SET RTFILE="^DIE("
DO EQUALS^RTUTL3
WRITE !?20,"Recompilation of '"_$SELECT(RTFILE["DIPT":"OUTPUT",RTFILE["DIE":"INPUT",1:"CROSS-REFERENCES")_$SELECT(RTFILE["DD(":"",1:"' Templates")
DO EQUALS^RTUTL3
+2 IF RTFILE'["DD("
SET RTX="RT "
FOR RTI=1:1
SET RTX=$ORDER(@(RTFILE_"""B"",RTX)"))
if RTX=""!($EXTRACT(RTX,1,3)'="RT ")
QUIT
SET Y=+$ORDER(^(RTX,0))
IF Y>0
IF $DATA(@(RTFILE_"+Y,""ROUOLD"")"))
IF ^("ROUOLD")]""
IF $DATA(^(0))
SET (RTEMP,Y)=+Y
SET X=$PIECE(^("ROUOLD"),"^")
SET RT0=^(0)
DO COMP
XX IF RTFILE["DD("
IF $DATA(@RTFILE)
SET (RT0,X)=^("DIK")
SET Y=+$PIECE(RTFILE,"DD(",2)
DO COMP
+1 QUIT
+2 KILL RT0,RTX,RTI,RTEMP,RTFILE,RTI
QUIT
+3 ;
QUIT
COMP WRITE !,"---- RE-COMPILING THE '",$PIECE(RT0,"^"),"' "_$SELECT(RTFILE["DIPT":"OUTPUT",RTFILE["DIE":"INPUT",1:"CROSS-REFERENCE")_" TEMPLATES"
+1 SET DMAX=4000
DO @($SELECT(RTFILE["DIPT":"EN^DIPZ",RTFILE["DIE":"EN^DIEZ",1:"EN^DIKZ"))
IF RTFILE'["DD("
IF $DATA(@(RTFILE_RTEMP_",""ROU"")"))
WRITE !!?3,"...'",$PIECE(RT0,"^"),"' has been re-compiled in the ",^("ROU"),"* routines."
DO EQUALS^RTUTL3
XZ IF RTFILE["DD("
IF $DATA(@(RTFILE))
WRITE !!?3,"...'",$PIECE(RT0,"^"),"' has been re-compiled in the ",^("DIK"),"* routines."
DO EQUALS^RTUTL3
+1 QUIT
+2 ;
BOTH SET U="^"
SET RTRD(1)="Yes^re-compile templates"
SET RTRD(2)="No^not re-compile templates"
SET RTRD("B")=2
SET RTRD(0)="S"
SET RTRD("A")="Are you sure you want to re-compile the record tracking templates? "
DO SET^RTRD
KILL RTRD
if $EXTRACT(X)'="Y"
QUIT
+1 SET RTFILE="^DIE("
DO RECOMP
WRITE !!
+2 SET RTFILE="^DIPT("
DO RECOMP
WRITE !!
XR SET RTK="0,"_"""DIK"""_")"
+1 SET RTFILE="^DD(190,"_RTK
DO RECOMP
WRITE !!
+2 SET RTFILE="^DD(190.1,"_RTK
DO XX
WRITE !!
+3 SET RTFILE="^DD(190.3,"_RTK
DO XX
WRITE !!
+4 SET RTFILE="^DD(194.2,"_RTK
DO XX
WRITE !!
+5 SET RTFILE="^DD(195.9,"_RTK
DO XX
WRITE !!
SDB ;
+1 WRITE !!,"Recompiling the Clinic Setup Template, don't worry"
+2 SET Y=$ORDER(^DIE("B","SDB",0))
if 'Y
QUIT
IF $DATA(^DIE(Y,"ROUOLD"))
SET X=^("ROUOLD")
IF X="SDBT"
SET DMAX=4000
DO EN^DIEZ
+3 WRITE "...Done.",!!,"NOTE: Recompilation should be performed on ALL systems."
+4 KILL A,C,L,O,X1,DQ,DIE,DMAX,DIEZ,DIEZDUP,DK,DR
+5 KILL X,RTX,RTK,RTI,RTFILE,RTEMP,RT0,J
+6 QUIT
+7 ;
FRCHK IF '$DATA(^%ZIS(1,"B",X))
KILL X
QUIT
+1 ;naked ref to %ZIS(1,"B",,n) and %ZIS(1,n,"SUBTYPE")
+2 IF '$DATA(^%ZIS(1,+$ORDER(^(X,0)),0))!('$DATA(^("SUBTYPE")))
KILL X
QUIT
+3 ;naked ref to the %ZIS(1,n,"SUBTYPE")
+4 IF '$DATA(^%ZIS(2,+^("SUBTYPE"),0))
KILL X
QUIT
+5 ;naked ref to %ZIS(2,n,0)
+6 IF $EXTRACT(^(0))'="C"
KILL X
QUIT
+7 if '$DATA(^RTV(195.9,"ADEV",X))
QUIT
SET X1=+$ORDER(^(X,0))
if D0=X1
QUIT
+8 IF $DATA(^RTV(195.9,X1,0))
SET X1=^(0)
WRITE !?5,*7,"...device is already assigned to ",$SELECT($DATA(^SC(+X1,0)):$PIECE(^(0),"^"),1:"UNKNOWN"),!?10," of the ",$SELECT($DATA(^DIC(195.1,+$PIECE(X1,"^",3),0)):$PIECE(^(0),"^"),1:"UNKNOWN")," application."
KILL X,X1
+9 QUIT
+10 ;
HELP ;Executeable Help for INPUT DEVICES multiple in file 195.9
+1 WRITE !!?3,"Device Name",?45,"Location",!?3,"-----------",?45,"--------"
+2 SET RTC=0
SET RTI=""
FOR RTI1=0:0
SET RTI=$ORDER(^%ZIS(1,"B",RTI))
if RTI=""
QUIT
SET RTX=+$ORDER(^(RTI,0))
IF $DATA(^%ZIS(1,RTX,0))
IF $DATA(^("SUBTYPE"))
IF $DATA(^%ZIS(2,+^("SUBTYPE"),0))
IF $EXTRACT(^(0))="C"
DO HELP1
if $DATA(RTESC)
QUIT
+3 KILL RTX,RTI,RTI1,RTC,RTESC
QUIT
HELP1 SET RTC=RTC+1
if '(RTC#20)
DO ESC^RTRD
if $DATA(RTESC)
QUIT
+1 SET RTX=^%ZIS(1,RTX,0)
WRITE !?3,$PIECE(RTX,"^"),$SELECT($PIECE(RTX,"^",9)]"":" ["_$PIECE(RTX,"^",9)_"]",1:"")
if $DATA(^(1))
WRITE ?45,$PIECE(^(1),"^")
QUIT
