BIPRE ;IHS/CMI/MWR - PRE-INIT ROUTINE; OCT 15, 2010
;;8.5;IMMUNIZATION;**9**;OCT 01,2014
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; PRE-INIT TO REMOVE PREVIOUS ^DD's, RPC's, Forms, List Templates,
;; and Protocols in the 9002084-9002084.9999 and BI* Spaces.
;; PATCH 1: Change DIU(0)="T" to DIU(0)="S" to preserve local templates: DD+7
;; PATCH 3: Clear BIMAN global for updates.
;; PATCH 9: Delete all previous BI TABLE DATA ELEMENTS.
;
;----------
MAIN ;EP
;---> Pre-init program.
;
D SETVARS^BIUTL5 S BIPOP=0
S BIPTITL="v"_$$VER^BILOGO_" PRE-INIT PROGRAM"
;D PERMISS(.BIPOP) I BIPOP D EXIT Q
;S DUZ(0)="@"
;
;---> Delete all old Error Codes. Added. vvv83
;D ZGBL^BIUTL8("^BIERR")
;---> Delete all previous BI Manufacturers.
;D ZGBL^BIUTL8("^BIMAN")
;---> Delete all previous BI Eligibility Codes (for preloaded Beta Sites).
;D ZGBL^BIUTL8("^BIELIG")
;
;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
;---> Delete all previous BI TABLE DATA ELEMENTS.
D ZGBL^BIUTL8("^BIEXPDD")
;
;W !!,"DO SOMETHING HERE?" R ZZZ
Q
;
;
D DD
D RPCS
D FORMS
D LISTS
D PROTOCOL
D CLRGLBS
D EXIT
Q
;
;
;----------
PERMISS(BIPOP) ;EP
;---> Set up proper permission to delete Data Dictionaries.
S BIPOP=0
Q:DUZ(0)["@"
W !!!! D TITLE^BIUTL5(BIPTITL)
D TEXT1,DIRZ^BIUTL3 S BIPOP=1
Q
;
;
;----------
DD ;EP
;---> Delete all BI Package Data Dictionaries.
N N
D TITLE^BIUTL5(BIPTITL)
D TEXT2
;---> BY DD#.
;
;********** PATCH 1, v8.2.1, FEB 01,2008, IHS/CMI/MWR
;---> PATCH 1: Change DIU(0)="T" to DIU(0)="S" to preserve local templates.
;S N=9002083.99999,DIU(0)="T"
S N=9002083.99999,DIU(0)="S"
;**********
;
F S N=$O(^DD(N)) Q:'+N Q:N'<9002085 D
.W !?6,N
.S DIU=N
.D EN^DIU2
;S N=9999999.14,DIU=N W !?6,N D EN^DIU2 ;IMMUNIZATION (VACCINE TABLE)
;S N=9999999.04,DIU=N W !?6,N D EN^DIU2 ;IMM MANUFACTURER
S N=9999999.41,DIU=N W !?6,N D EN^DIU2 ;IMMUNIZATION LOT
K DIU
W !?5,"Data Dictionary deletion complete." H 1
;
F N="ERR","EXPDD","SERT" D
.D ZGBL^BIUTL8("^BI"_N)
W !?5,"Old BI standard tables deletion complete." H 1
;
Q
;
;
;----------
RPCS ;EP
;---> Delete all RPCs in BI Namespace.
W !!!?6,"The Pre-Initialization Program is removing all old Remote"
W !?6,"Procedure Calls. Please stand by...",!
S N="BI",DIK="^XWB(8994,"
F S N=$O(^XWB(8994,"B",N)) Q:N=""!(N]"BIZZZ") D
.S DA=$O(^XWB(8994,"B",N,0))
.D ^DIK
Q
;
;
;----------
FORMS ;EP
;---> Delete all BI Forms and Blocks.
W !!!?6,"The Pre-Initialization Program is removing all old Screenman"
W !?6,"forms and blocks. Please stand by...",!
S N="BI",DIK="^DIST(.403,"
F S N=$O(^DIST(.403,"B",N)) Q:N=""!(N]"BIZZZ") D
.S DA=$O(^DIST(.403,"B",N,0))
.D ^DIK
;
S N="BI",DIK="^DIST(.404,"
F S N=$O(^DIST(.404,"B",N)) Q:N=""!(N]"BIZZZ") D
.S DA=$O(^DIST(.404,"B",N,0))
.D ^DIK
W !?6,"Screen deletions complete." H 1
Q
;
;
;----------
LISTS ;EP
;---> Delete all LIST Templates in BI Namespace.
W !!!?6,"The Pre-Initialization Program is removing all old"
W !?6,"List Templates. Please stand by...",!
S N="BI",DIK="^SD(409.61,"
F S N=$O(^SD(409.61,"B",N)) Q:N=""!(N]"BIZZZ") D
.S DA=$O(^SD(409.61,"B",N,0))
.D ^DIK
Q
;
;
;----------
PROTOCOL ;EP
;---> Delete all Protocols in BI Namespace.
W !!!?6,"The Pre-Initialization Program is removing all old Protocols"
W !?6,"Please stand by...",!
S N="BI",DIK="^ORD(101,"
F S N=$O(^ORD(101,"B",N)) Q:N=""!(N]"BIZZZ") D
.S DA=$O(^ORD(101,"B",N,0))
.D ^DIK
Q
;
;
;----------
CLRGLBS ;EP
;---> Delete globals of standard data that will have data placed
;---> in them by KIDS.
;---> Delete all old text in BI PACKAGE INFORMATION.
D ZGBL^BIUTL8("^BINFO")
;---> Delete all old Sample Letters.
D ZGBL^BIUTL8("^BILETS")
;---> Delete all old Error Codes. Added. vvv83
D ZGBL^BIUTL8("^BIERR")
;---> Delete VT-100 Codes.
D KGBL^BIUTL8("^BIVT100")
Q
;
;
;----------
TEXT1 ;
;;This preinit clears all data dictionaries out of the Immunization
;;number space (9002084-9002084.99) before loading the new data
;;dictionaries. In order for this to occur, your DUZ(0) must contain
;;the "@". Your DUZ(0), however, does NOT contain the "@", and the
;;SAC standards prevent this program from setting it for you.
;;
;;You can set your DUZ(0)=@ by entering S DUZ(0)="@" at the programmer
;;prompt, or by entering Fileman in programmer mode: enter D P^DI at
;;the programmer prompt and then simply press RETURN to back out of it.
;;
;;After resetting your DUZ(0), you may begin the init process again
;;by entering D ^BIINIT at the programmer prompt.
;;
;;This init will now terminate without having made any changes to the
;;current software.
D PRINTX("TEXT1")
Q
;
;
;----------
TEXT2 ;
;;The Pre-Initialization Program is removing all old Data Dictionaries
;;in the 9002084-9002084.9999 number space and old BI standard tables.
;;Please stand by...
;;
D PRINTX("TEXT2")
Q
;
;
PRINTX(BILINL,BITAB) ;EP
Q:$G(BILINL)=""
N I,T,X S T="" S:'$D(BITAB) BITAB=5 F I=1:1:BITAB S T=T_" "
F I=1:1 S X=$T(@BILINL+I) Q:X'[";;" W !,T,$P(X,";;",2)
Q
;
;
;----------
EXIT ;EP
;---> End of job cleanup.
D KILLALL^BIUTL8(1)
Q
BIPRE ;IHS/CMI/MWR - PRE-INIT ROUTINE; OCT 15, 2010
+1 ;;8.5;IMMUNIZATION;**9**;OCT 01,2014
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; PRE-INIT TO REMOVE PREVIOUS ^DD's, RPC's, Forms, List Templates,
+4 ;; and Protocols in the 9002084-9002084.9999 and BI* Spaces.
+5 ;; PATCH 1: Change DIU(0)="T" to DIU(0)="S" to preserve local templates: DD+7
+6 ;; PATCH 3: Clear BIMAN global for updates.
+7 ;; PATCH 9: Delete all previous BI TABLE DATA ELEMENTS.
+8 ;
+9 ;----------
MAIN ;EP
+1 ;---> Pre-init program.
+2 ;
+3 DO SETVARS^BIUTL5
SET BIPOP=0
+4 SET BIPTITL="v"_$$VER^BILOGO_" PRE-INIT PROGRAM"
+5 ;D PERMISS(.BIPOP) I BIPOP D EXIT Q
+6 ;S DUZ(0)="@"
+7 ;
+8 ;---> Delete all old Error Codes. Added. vvv83
+9 ;D ZGBL^BIUTL8("^BIERR")
+10 ;---> Delete all previous BI Manufacturers.
+11 ;D ZGBL^BIUTL8("^BIMAN")
+12 ;---> Delete all previous BI Eligibility Codes (for preloaded Beta Sites).
+13 ;D ZGBL^BIUTL8("^BIELIG")
+14 ;
+15 ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
+16 ;---> Delete all previous BI TABLE DATA ELEMENTS.
+17 DO ZGBL^BIUTL8("^BIEXPDD")
+18 ;
+19 ;W !!,"DO SOMETHING HERE?" R ZZZ
+20 QUIT
+21 ;
+22 ;
+23 DO DD
+24 DO RPCS
+25 DO FORMS
+26 DO LISTS
+27 DO PROTOCOL
+28 DO CLRGLBS
+29 DO EXIT
+30 QUIT
+31 ;
+32 ;
+33 ;----------
PERMISS(BIPOP) ;EP
+1 ;---> Set up proper permission to delete Data Dictionaries.
+2 SET BIPOP=0
+3 IF DUZ(0)["@"
QUIT
+4 WRITE !!!!
DO TITLE^BIUTL5(BIPTITL)
+5 DO TEXT1
DO DIRZ^BIUTL3
SET BIPOP=1
+6 QUIT
+7 ;
+8 ;
+9 ;----------
DD ;EP
+1 ;---> Delete all BI Package Data Dictionaries.
+2 NEW N
+3 DO TITLE^BIUTL5(BIPTITL)
+4 DO TEXT2
+5 ;---> BY DD#.
+6 ;
+7 ;********** PATCH 1, v8.2.1, FEB 01,2008, IHS/CMI/MWR
+8 ;---> PATCH 1: Change DIU(0)="T" to DIU(0)="S" to preserve local templates.
+9 ;S N=9002083.99999,DIU(0)="T"
+10 SET N=9002083.99999
SET DIU(0)="S"
+11 ;**********
+12 ;
+13 FOR
SET N=$ORDER(^DD(N))
IF '+N
QUIT
IF N'<9002085
QUIT
Begin DoDot:1
+14 WRITE !?6,N
+15 SET DIU=N
+16 DO EN^DIU2
End DoDot:1
+17 ;S N=9999999.14,DIU=N W !?6,N D EN^DIU2 ;IMMUNIZATION (VACCINE TABLE)
+18 ;S N=9999999.04,DIU=N W !?6,N D EN^DIU2 ;IMM MANUFACTURER
+19 ;IMMUNIZATION LOT
SET N=9999999.41
SET DIU=N
WRITE !?6,N
DO EN^DIU2
+20 KILL DIU
+21 WRITE !?5,"Data Dictionary deletion complete."
HANG 1
+22 ;
+23 FOR N="ERR","EXPDD","SERT"
Begin DoDot:1
+24 DO ZGBL^BIUTL8("^BI"_N)
End DoDot:1
+25 WRITE !?5,"Old BI standard tables deletion complete."
HANG 1
+26 ;
+27 QUIT
+28 ;
+29 ;
+30 ;----------
RPCS ;EP
+1 ;---> Delete all RPCs in BI Namespace.
+2 WRITE !!!?6,"The Pre-Initialization Program is removing all old Remote"
+3 WRITE !?6,"Procedure Calls. Please stand by...",!
+4 SET N="BI"
SET DIK="^XWB(8994,"
+5 FOR
SET N=$ORDER(^XWB(8994,"B",N))
IF N=""!(N]"BIZZZ")
QUIT
Begin DoDot:1
+6 SET DA=$ORDER(^XWB(8994,"B",N,0))
+7 DO ^DIK
End DoDot:1
+8 QUIT
+9 ;
+10 ;
+11 ;----------
FORMS ;EP
+1 ;---> Delete all BI Forms and Blocks.
+2 WRITE !!!?6,"The Pre-Initialization Program is removing all old Screenman"
+3 WRITE !?6,"forms and blocks. Please stand by...",!
+4 SET N="BI"
SET DIK="^DIST(.403,"
+5 FOR
SET N=$ORDER(^DIST(.403,"B",N))
IF N=""!(N]"BIZZZ")
QUIT
Begin DoDot:1
+6 SET DA=$ORDER(^DIST(.403,"B",N,0))
+7 DO ^DIK
End DoDot:1
+8 ;
+9 SET N="BI"
SET DIK="^DIST(.404,"
+10 FOR
SET N=$ORDER(^DIST(.404,"B",N))
IF N=""!(N]"BIZZZ")
QUIT
Begin DoDot:1
+11 SET DA=$ORDER(^DIST(.404,"B",N,0))
+12 DO ^DIK
End DoDot:1
+13 WRITE !?6,"Screen deletions complete."
HANG 1
+14 QUIT
+15 ;
+16 ;
+17 ;----------
LISTS ;EP
+1 ;---> Delete all LIST Templates in BI Namespace.
+2 WRITE !!!?6,"The Pre-Initialization Program is removing all old"
+3 WRITE !?6,"List Templates. Please stand by...",!
+4 SET N="BI"
SET DIK="^SD(409.61,"
+5 FOR
SET N=$ORDER(^SD(409.61,"B",N))
IF N=""!(N]"BIZZZ")
QUIT
Begin DoDot:1
+6 SET DA=$ORDER(^SD(409.61,"B",N,0))
+7 DO ^DIK
End DoDot:1
+8 QUIT
+9 ;
+10 ;
+11 ;----------
PROTOCOL ;EP
+1 ;---> Delete all Protocols in BI Namespace.
+2 WRITE !!!?6,"The Pre-Initialization Program is removing all old Protocols"
+3 WRITE !?6,"Please stand by...",!
+4 SET N="BI"
SET DIK="^ORD(101,"
+5 FOR
SET N=$ORDER(^ORD(101,"B",N))
IF N=""!(N]"BIZZZ")
QUIT
Begin DoDot:1
+6 SET DA=$ORDER(^ORD(101,"B",N,0))
+7 DO ^DIK
End DoDot:1
+8 QUIT
+9 ;
+10 ;
+11 ;----------
CLRGLBS ;EP
+1 ;---> Delete globals of standard data that will have data placed
+2 ;---> in them by KIDS.
+3 ;---> Delete all old text in BI PACKAGE INFORMATION.
+4 DO ZGBL^BIUTL8("^BINFO")
+5 ;---> Delete all old Sample Letters.
+6 DO ZGBL^BIUTL8("^BILETS")
+7 ;---> Delete all old Error Codes. Added. vvv83
+8 DO ZGBL^BIUTL8("^BIERR")
+9 ;---> Delete VT-100 Codes.
+10 DO KGBL^BIUTL8("^BIVT100")
+11 QUIT
+12 ;
+13 ;
+14 ;----------
TEXT1 ;
+1 ;;This preinit clears all data dictionaries out of the Immunization
+2 ;;number space (9002084-9002084.99) before loading the new data
+3 ;;dictionaries. In order for this to occur, your DUZ(0) must contain
+4 ;;the "@". Your DUZ(0), however, does NOT contain the "@", and the
+5 ;;SAC standards prevent this program from setting it for you.
+6 ;;
+7 ;;You can set your DUZ(0)=@ by entering S DUZ(0)="@" at the programmer
+8 ;;prompt, or by entering Fileman in programmer mode: enter D P^DI at
+9 ;;the programmer prompt and then simply press RETURN to back out of it.
+10 ;;
+11 ;;After resetting your DUZ(0), you may begin the init process again
+12 ;;by entering D ^BIINIT at the programmer prompt.
+13 ;;
+14 ;;This init will now terminate without having made any changes to the
+15 ;;current software.
+16 DO PRINTX("TEXT1")
+17 QUIT
+18 ;
+19 ;
+20 ;----------
TEXT2 ;
+1 ;;The Pre-Initialization Program is removing all old Data Dictionaries
+2 ;;in the 9002084-9002084.9999 number space and old BI standard tables.
+3 ;;Please stand by...
+4 ;;
+5 DO PRINTX("TEXT2")
+6 QUIT
+7 ;
+8 ;
PRINTX(BILINL,BITAB) ;EP
+1 IF $GET(BILINL)=""
QUIT
+2 NEW I,T,X
SET T=""
IF '$DATA(BITAB)
SET BITAB=5
FOR I=1:1:BITAB
SET T=T_" "
+3 FOR I=1:1
SET X=$TEXT(@BILINL+I)
IF X'[";;"
QUIT
WRITE !,T,$PIECE(X,";;",2)
+4 QUIT
+5 ;
+6 ;
+7 ;----------
EXIT ;EP
+1 ;---> End of job cleanup.
+2 DO KILLALL^BIUTL8(1)
+3 QUIT
