- 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
