DVBAPOPU ;ALB/JLU;utility routine for post inits;9/1/94
;;2.7;AMIE;;Apr 10, 1995
EN ;the main entry point
D SETPURG
Q
;
SETPURG ;this set up the DAYS TO KEEP 2507 HISTORY parameter.
N PAR
S VAR=" - Checking 2507 purge parameter"
W !!,VAR
D BUMPBLK^DVBAPOST,BUMPBLK^DVBAPOST,BUMP^DVBAPOST(VAR)
K VAR
S PAR=$$IFNPAR^DVBAUTL3
I 'PAR DO I 1
.N VAR
.S VAR="No parameter file entry exists!"
.W *7,!!,VAR
.D BUMPBLK^DVBAPOST,BUMPBLK^DVBAPOST,BUMP^DVBAPOST(VAR)
.S VAR="Consult the AMIE installation manual for further details."
.W !,VAR
.D BUMP^DVBAPOST(VAR)
.Q
E DO
.I +$P(^DVB(396.1,PAR,0),U,11)>119 Q
.S $P(^DVB(396.1,PAR,0),U,11)=120
.Q
Q
;
IEN6(X) ;this entry point returns the internal value of the amie exam file
;a null is returned if not found.
;
N X1
S X1=$O(^DVB(396.6,"B",$E(X,1,30),0))
I X1="" D ERR1("AMIE EXAM file",X) Q X1
I '$D(^DVB(396.6,X1,0)) D ERR2("AMIE EXAM file",X) S X1=""
Q X1
;
IEN7(X) ;this entry point returns the internal value of the amie 2507 BODY SYSTEM
;file.
;a null is returned if not found.
;
N X1
S X1=$O(^DVB(396.7,"B",X,0))
I X1="" D ERR1("2507 BODY SYSTEM file",X) Q X1
I '$D(^DVB(396.7,X1,0)) D ERR2("2507 BODY SYSTEM file",X) S X1=""
Q X1
;
ERR1(A,B) ;this entry point is to inform the user of an error in the
;B cross reference of the file
;A is the file name
;B is the entry number
D BUMPBLK^DVBAPOST
D BUMPBLK^DVBAPOST
S VAR="The entry "_B_" is not defined in "_A
W !,VAR D BUMP^DVBAPOST(VAR)
S VAR="Consult the AMIE Install Guide for details"
W !,VAR D BUMP^DVBAPOST(VAR)
Q
;
ERR2(A,B) ;this entry point is to inform the user of an error in the
;the zero node of the file
;A is the file name
;B is the entry number
D BUMPBLK^DVBAPOST
D BUMPBLK^DVBAPOST
S VAR="The zero node of the entry "_B_" is missing in the "_A
W !,VAR D BUMP^DVBAPOST(VAR)
S VAR="Consult the AMIE Install Guide for details"
W !,VAR D BUMP^DVBAPOST(VAR)
Q
;
DELETE ;this entry point is used to kill the files 396.91, and 396.92
N VAR
K ^DVBP(396.91)
K ^DVBP(396.92)
S VAR(1,0)="0,0,0,1,0^Removal of data from file 396.91 and 396.92 is complete!"
D WR^DVBAUTL4("VAR")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAPOPU 2229 printed Sep 23, 2025@19:17:48 Page 2
DVBAPOPU ;ALB/JLU;utility routine for post inits;9/1/94
+1 ;;2.7;AMIE;;Apr 10, 1995
EN ;the main entry point
+1 DO SETPURG
+2 QUIT
+3 ;
SETPURG ;this set up the DAYS TO KEEP 2507 HISTORY parameter.
+1 NEW PAR
+2 SET VAR=" - Checking 2507 purge parameter"
+3 WRITE !!,VAR
+4 DO BUMPBLK^DVBAPOST
DO BUMPBLK^DVBAPOST
DO BUMP^DVBAPOST(VAR)
+5 KILL VAR
+6 SET PAR=$$IFNPAR^DVBAUTL3
+7 IF 'PAR
Begin DoDot:1
+8 NEW VAR
+9 SET VAR="No parameter file entry exists!"
+10 WRITE *7,!!,VAR
+11 DO BUMPBLK^DVBAPOST
DO BUMPBLK^DVBAPOST
DO BUMP^DVBAPOST(VAR)
+12 SET VAR="Consult the AMIE installation manual for further details."
+13 WRITE !,VAR
+14 DO BUMP^DVBAPOST(VAR)
+15 QUIT
End DoDot:1
IF 1
+16 IF '$TEST
Begin DoDot:1
+17 IF +$PIECE(^DVB(396.1,PAR,0),U,11)>119
QUIT
+18 SET $PIECE(^DVB(396.1,PAR,0),U,11)=120
+19 QUIT
End DoDot:1
+20 QUIT
+21 ;
IEN6(X) ;this entry point returns the internal value of the amie exam file
+1 ;a null is returned if not found.
+2 ;
+3 NEW X1
+4 SET X1=$ORDER(^DVB(396.6,"B",$EXTRACT(X,1,30),0))
+5 IF X1=""
DO ERR1("AMIE EXAM file",X)
QUIT X1
+6 IF '$DATA(^DVB(396.6,X1,0))
DO ERR2("AMIE EXAM file",X)
SET X1=""
+7 QUIT X1
+8 ;
IEN7(X) ;this entry point returns the internal value of the amie 2507 BODY SYSTEM
+1 ;file.
+2 ;a null is returned if not found.
+3 ;
+4 NEW X1
+5 SET X1=$ORDER(^DVB(396.7,"B",X,0))
+6 IF X1=""
DO ERR1("2507 BODY SYSTEM file",X)
QUIT X1
+7 IF '$DATA(^DVB(396.7,X1,0))
DO ERR2("2507 BODY SYSTEM file",X)
SET X1=""
+8 QUIT X1
+9 ;
ERR1(A,B) ;this entry point is to inform the user of an error in the
+1 ;B cross reference of the file
+2 ;A is the file name
+3 ;B is the entry number
+4 DO BUMPBLK^DVBAPOST
+5 DO BUMPBLK^DVBAPOST
+6 SET VAR="The entry "_B_" is not defined in "_A
+7 WRITE !,VAR
DO BUMP^DVBAPOST(VAR)
+8 SET VAR="Consult the AMIE Install Guide for details"
+9 WRITE !,VAR
DO BUMP^DVBAPOST(VAR)
+10 QUIT
+11 ;
ERR2(A,B) ;this entry point is to inform the user of an error in the
+1 ;the zero node of the file
+2 ;A is the file name
+3 ;B is the entry number
+4 DO BUMPBLK^DVBAPOST
+5 DO BUMPBLK^DVBAPOST
+6 SET VAR="The zero node of the entry "_B_" is missing in the "_A
+7 WRITE !,VAR
DO BUMP^DVBAPOST(VAR)
+8 SET VAR="Consult the AMIE Install Guide for details"
+9 WRITE !,VAR
DO BUMP^DVBAPOST(VAR)
+10 QUIT
+11 ;
DELETE ;this entry point is used to kill the files 396.91, and 396.92
+1 NEW VAR
+2 KILL ^DVBP(396.91)
+3 KILL ^DVBP(396.92)
+4 SET VAR(1,0)="0,0,0,1,0^Removal of data from file 396.91 and 396.92 is complete!"
+5 DO WR^DVBAUTL4("VAR")
+6 QUIT
