ABPVPRE1 ;PRE-PRE-INITIALIZATION TASKS; [ 05/31/91 12:15 PM ]
;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
;---------------------------------------------------------------------
ACTIONS ;PROCEDURE TO REMOVE CURRENT OPTION ENTRY & EXIT ACTIONS
W !!,"Preparing the current options for updating..."
S ABPVR="ABPV" F I=0:0 D Q:$E(ABPVR,1,4)'="ABPV"
.S ABPVR=$O(^DIC(19,"B",ABPVR)) Q:$E(ABPVR,1,4)'="ABPV"
.S ABPVRR=0 F J=0:0 D Q:+ABPVRR=0
..S ABPVRR=$O(^DIC(19,"B",ABPVR,ABPVRR)) Q:+ABPVRR=0
..K ^DIC(19,ABPVRR,15),^DIC(19,ABPVRR,20)
W "done!"
;---------------------------------------------------------------------
INPUT ;PROCEDURE TO DELETE ALL CURRENT PACKAGE INPUT TEMPLATES
W !,"Deleting the current input templates..."
S ABPVR="ABPV" F I=0:0 D Q:$E(ABPVR,1,4)'="ABPV"
.S ABPVR=$O(^DIE("B",ABPVR)) Q:$E(ABPVR,1,4)'="ABPV"
.S ABPVRR=0 F J=0:0 D Q:+ABPVRR=0
..S ABPVRR=$O(^DIE("B",ABPVR,ABPVRR)) Q:+ABPVRR=0
..K DIK,DA S DIK="^DIE(",DA=ABPVRR D ^DIK W "."
W "done!"
;---------------------------------------------------------------------
SORT ;PROCEDURE TO DELETE ALL CURRENT PACKAGE SORT TEMPLATES
W !,"Deleting the current sort templates..."
S ABPVR="ABPV" F I=0:0 D Q:$E(ABPVR,1,4)'="ABPV"
.S ABPVR=$O(^DIBT("B",ABPVR)) Q:$E(ABPVR,1,4)'="ABPV"
.S ABPVRR=0 F J=0:0 D Q:+ABPVRR=0
..S ABPVRR=$O(^DIBT("B",ABPVR,ABPVRR)) Q:+ABPVRR=0
..K DIK,DA S DIK="^DIBT(",DA=ABPVRR D ^DIK W "."
W "done!"
;---------------------------------------------------------------------
PRINT ;PROCEDURE TO DELETE ALL CURRENT PACKAGE PRINT TEMPLATES
W !,"Deleting the current print templates..."
S ABPVR="ABPV" F I=0:0 D Q:$E(ABPVR,1,4)'="ABPV"
.S ABPVR=$O(^DIPT("B",ABPVR)) Q:$E(ABPVR,1,4)'="ABPV"
.S ABPVRR=0 F J=0:0 D Q:+ABPVRR=0
..S ABPVRR=$O(^DIPT("B",ABPVR,ABPVRR)) Q:+ABPVRR=0
..K DIK,DA S DIK="^DIPT(",DA=ABPVRR D ^DIK W "."
W "done!"
;---------------------------------------------------------------------
D ^ABPVPREI
Q
ABPVPRE1 ;PRE-PRE-INITIALIZATION TASKS; [ 05/31/91 12:15 PM ]
+1 ;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
+2 ;---------------------------------------------------------------------
ACTIONS ;PROCEDURE TO REMOVE CURRENT OPTION ENTRY & EXIT ACTIONS
+1 WRITE !!,"Preparing the current options for updating..."
+2 SET ABPVR="ABPV"
FOR I=0:0
Begin DoDot:1
+3 SET ABPVR=$ORDER(^DIC(19,"B",ABPVR))
IF $EXTRACT(ABPVR,1,4)'="ABPV"
QUIT
+4 SET ABPVRR=0
FOR J=0:0
Begin DoDot:2
+5 SET ABPVRR=$ORDER(^DIC(19,"B",ABPVR,ABPVRR))
IF +ABPVRR=0
QUIT
+6 KILL ^DIC(19,ABPVRR,15),^DIC(19,ABPVRR,20)
End DoDot:2
IF +ABPVRR=0
QUIT
End DoDot:1
IF $EXTRACT(ABPVR,1,4)'="ABPV"
QUIT
+7 WRITE "done!"
+8 ;---------------------------------------------------------------------
INPUT ;PROCEDURE TO DELETE ALL CURRENT PACKAGE INPUT TEMPLATES
+1 WRITE !,"Deleting the current input templates..."
+2 SET ABPVR="ABPV"
FOR I=0:0
Begin DoDot:1
+3 SET ABPVR=$ORDER(^DIE("B",ABPVR))
IF $EXTRACT(ABPVR,1,4)'="ABPV"
QUIT
+4 SET ABPVRR=0
FOR J=0:0
Begin DoDot:2
+5 SET ABPVRR=$ORDER(^DIE("B",ABPVR,ABPVRR))
IF +ABPVRR=0
QUIT
+6 KILL DIK,DA
SET DIK="^DIE("
SET DA=ABPVRR
DO ^DIK
WRITE "."
End DoDot:2
IF +ABPVRR=0
QUIT
End DoDot:1
IF $EXTRACT(ABPVR,1,4)'="ABPV"
QUIT
+7 WRITE "done!"
+8 ;---------------------------------------------------------------------
SORT ;PROCEDURE TO DELETE ALL CURRENT PACKAGE SORT TEMPLATES
+1 WRITE !,"Deleting the current sort templates..."
+2 SET ABPVR="ABPV"
FOR I=0:0
Begin DoDot:1
+3 SET ABPVR=$ORDER(^DIBT("B",ABPVR))
IF $EXTRACT(ABPVR,1,4)'="ABPV"
QUIT
+4 SET ABPVRR=0
FOR J=0:0
Begin DoDot:2
+5 SET ABPVRR=$ORDER(^DIBT("B",ABPVR,ABPVRR))
IF +ABPVRR=0
QUIT
+6 KILL DIK,DA
SET DIK="^DIBT("
SET DA=ABPVRR
DO ^DIK
WRITE "."
End DoDot:2
IF +ABPVRR=0
QUIT
End DoDot:1
IF $EXTRACT(ABPVR,1,4)'="ABPV"
QUIT
+7 WRITE "done!"
+8 ;---------------------------------------------------------------------
PRINT ;PROCEDURE TO DELETE ALL CURRENT PACKAGE PRINT TEMPLATES
+1 WRITE !,"Deleting the current print templates..."
+2 SET ABPVR="ABPV"
FOR I=0:0
Begin DoDot:1
+3 SET ABPVR=$ORDER(^DIPT("B",ABPVR))
IF $EXTRACT(ABPVR,1,4)'="ABPV"
QUIT
+4 SET ABPVRR=0
FOR J=0:0
Begin DoDot:2
+5 SET ABPVRR=$ORDER(^DIPT("B",ABPVR,ABPVRR))
IF +ABPVRR=0
QUIT
+6 KILL DIK,DA
SET DIK="^DIPT("
SET DA=ABPVRR
DO ^DIK
WRITE "."
End DoDot:2
IF +ABPVRR=0
QUIT
End DoDot:1
IF $EXTRACT(ABPVR,1,4)'="ABPV"
QUIT
+7 WRITE "done!"
+8 ;---------------------------------------------------------------------
+9 DO ^ABPVPREI
+10 QUIT
