- 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
