AUT98P26 ; IHS/OIT/FBD - AUT V98.1 PATCH 26 ENVIRONMENT CHECKS AND POST-INIT PROCESS;
;;98.1;IHS DICTIONARIES (POINTERS);**25**;FEB 9,2011;Build 6
;
;
; The following line prevents the "Disable Options..." and "Move Routines..." questions from being asked during the install.
I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0
;KERNEL
I +$$VERSION^XPDUTL("XU")<8 D MES^XPDUTL($$CJ^XLFSTR("Version 8.0 of KERNEL is required. Not installed",80)) D SORRY(2) I 1
E D MES^XPDUTL($$CJ^XLFSTR("Requires Kernel Version 8.0....Present.",80))
;FILEMAN
I +$$VERSION^XPDUTL("DI")<22 D MES^XPDUTL($$CJ^XLFSTR("Version 22.0 of FILEMAN is required. Not installed.",80)) D SORRY(2) I 1
E D MES^XPDUTL($$CJ^XLFSTR("Requires Fileman v22....Present.",80))
;AUT
I $$VERSION^XPDUTL("AUT")'="98.1" D MES^XPDUTL($$CJ^XLFSTR("Version 98.1 of the IHS DICTIONARIES (POINTERS) is required. Not installed",80)) D SORRY(2) I 1
E D MES^XPDUTL($$CJ^XLFSTR("Requires IHS DICTIONARIES (POINTERS) Version 98.1....Present.",80))
;AUT 98.1 PATCH 25
I '$$INSTALLD("AUT*98.1*25") D SORRY(2)
;
;CHECK IF PROVIDER TYPES IN '3P PROVIDER TAXONOMY' FILE MATCH PROPER PROVIDER CLASS CODES
D MES^XPDUTL($$CJ^XLFSTR("Valid provider classes required in 3P PROVIDER TAXONOMY file...",80))
IF $$PTXSCAN D MES^XPDUTL($$CJ^XLFSTR("Invalid provider classes found in 3P PROVIDER TAXONOMY file.",80)) D SORRY(2) I 1
E D MES^XPDUTL($$CJ^XLFSTR("Provider classes in 3P PROVIDER TAXONOMY validate properly.",80))
;
Q ;END OF ENVIRONMENT CHECK
;
PRE ;PATCH 26 PRE-INIT CHECKS AND PROCESSES
D MES^XPDUTL($$CJ^XLFSTR("Beginning AUT v98.1 patch 26 pre-init process.",80))
;
;
D MES^XPDUTL($$CJ^XLFSTR("AUT v98.1 patch 26 pre-init process complete.",80))
Q
;
PTXSCAN() ;PRE-SCAN OF PROVIDER TYPES SPECIFIED IN '3P PROVIDER TAXONOMY' FILE
;RETURN VALUE: 1 IF INVALID CODES DETECTED, 0 (ZERO) IF CLEAN
N FLAG,PTXIEN,PRVCODE,PIECE,SPEC,MSG
S FLAG=0 ;IF FLAG PASSES THROUGH SCAN UNAFFECTED, SCAN IS CLEAN
S PTXIEN=0
F S PTXIEN=$O(^ABMPTAX(PTXIEN)) Q:'+PTXIEN D ;
.F PIECE=2,4,5 D ;NODE PIECES FOR PROVIDER CLASS (#.02), PROVIDER CLASS 2 (#.04) AND PROVIDER CLASS 3 (#.05) FIELDS
..S PRVCODE=$P(^ABMPTAX(PTXIEN,0),U,PIECE) Q:PRVCODE=""
..I '+$O(^DIC(7,"D",PRVCODE,"")) D ;NO CORRESPONDING CODE FOUND IN 'D' XREF OF PROVIDER CLASS FILE, SO CODE IS INVALID
...S FLAG=1
...S SPEC=$S(PIECE=4:" 2",PIECE=5:" 3",1:"")
...S MSG="Record IEN "_PTXIEN_": invalid code "_PRVCODE_" found in PROVIDER CLASS"_SPEC_" field."
...D MES^XPDUTL($$CJ^XLFSTR(MSG,80))
Q FLAG
;
POST ;PATCH 26 POST-INIT PROCESSES
D MES^XPDUTL($$CJ^XLFSTR("Beginning AUT v98.1 patch 26 post-init process.",80))
;
D MTPOP ;POPULATE 'EDUCATION TOPICS' FILE'S NEW 'MAJOR TOPIC PTR' FIELD
D ITPOP ;POPULATE 'INSURER' FILE'S NEW 'INSURER TYPE' FIELD
D PTXUP ;UPDATE 'PROVIDER TAXONOMY' FILE -
;
D MES^XPDUTL($$CJ^XLFSTR("AUT v98.1 patch 26 post-init process complete.",80))
Q
;
MTPOP ;EDUCATION MAJOR TOPICS FIELD POPULATION
D MES^XPDUTL($$CJ^XLFSTR("Populating EDUCATION TOPICS file / MAJOR TOPICS PTR field...",80))
D CVTALL^AUTEMTP
D MES^XPDUTL($$CJ^XLFSTR("EDUCATION TOPICS / MAJOR TOPICS PTR field population complete.",80))
Q
;
ITPOP ;INSURER / INSURER TYPE FIELD POPULATION
D MES^XPDUTL($$CJ^XLFSTR("Populating INSURER file / INSURER TYPE field...",80))
D CVTALL^AUTCVIT
D MES^XPDUTL($$CJ^XLFSTR("INSURER / INSURER TYPE field population complete.",80))
Q
;
PTXUP ;UPDATE 'PROVIDER TAXONOMY' WITH INFORMATION FROM '3P PROVIDER TAXONOMY'
;PROVIDER TAXONOMY ENTRIES WHICH MATCH TO 3P TAXONOMY ENTRIES ARE UPDATED WITH
;CORRESPONDING PROVIDER CLASS INFORMATION.
N P3TXIEN,PTXIEN,NUCC,PERC,PRVC1,PRVC2,PRVC3,DA,DIE,DR
S PTXIEN=0
F S PTXIEN=$O(^AUTTPTAX(PTXIEN)) Q:'+PTXIEN D ;SCANNING PROVIDER TAXONOMY
.S NUCC=$P(^AUTTPTAX(PTXIEN,1),U,1)
.S P3TXIEN=$O(^ABMPTAX("B",NUCC,"")) Q:P3TXIEN="" ;CORRESPONDING 3P PROVIDER TAXONOMY ENTRY
.S PERC=$P(^ABMPTAX(P3TXIEN,0),U,3) ;PERSON CLASS
.S PRVC1=$P(^ABMPTAX(P3TXIEN,0),U,2) S:PRVC1'="" PRVC1=+$O(^DIC(7,"D",PRVC1,"")) ;PROVIDER CLASS
.S PRVC2=$P(^ABMPTAX(P3TXIEN,0),U,4) S:PRVC2'="" PRVC2=+$O(^DIC(7,"D",PRVC2,"")) ;PROVIDER CLASS 2
.S PRVC3=$P(^ABMPTAX(P3TXIEN,0),U,5) S:PRVC3'="" PRVC3=+$O(^DIC(7,"D",PRVC3,"")) ;PROVIDER CLASS 3
.K DA,DIE,DR S DR=""
.S DIE="^AUTTPTAX(",DA=PTXIEN
.I +PERC S DR="3///`"_PERC
.I +PRVC1 S:+$L(DR) DR=DR_";" S DR=DR_"4.1///`"_PRVC1
.I +PRVC2 S:+$L(DR) DR=DR_";" S DR=DR_"4.2///`"_PRVC2
.I +PRVC3 S:+$L(DR) DR=DR_";" S DR=DR_"4.3///`"_PRVC3
.Q:DR="" ;SKIP EDIT IF NOTHING TO TRANSFER
.D ^DIE K DA,DIE,DR
;
AUSC ;POST-UPDATE CLEANUP
K DIK
K ^AUTTPTAX("AUSC") ;FLUSH POTENTIALLY CORRUPTED CROSS-REFERENCES
S DIK="^AUTTPTAX(" ;IN PROVIDER TAXONOMY FILE
S DIK(1)="3^AUSC" ;OF "PERSON CLASS" FIELD'S "AUSC" XREF
D ENALL^DIK ;THEN REBUILD "AUSC" XREF FOR ALL XREFS
Q
;
INSTALLD(AUTSTAL) ;EP - Determine if patch AUTSTAL was installed, where
; AUTSTAL is the name of the INSTALL. E.g "AG*6.0*11".
;
NEW AUTY,DIC,X,Y
S X=$P(AUTSTAL,"*",1)
S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
D IX^DIC
I Y<1 D IMES Q 0
S DIC=DIC_+Y_",22,",X=$P(AUTSTAL,"*",2)
D ^DIC
I Y<1 D IMES Q 0
S DIC=DIC_+Y_",""PAH"",",X=$P(AUTSTAL,"*",3)
D ^DIC
S AUTY=Y
D IMES
Q $S(AUTY<1:0,1:1)
IMES ;
D MES^XPDUTL($$CJ^XLFSTR("Patch """_AUTSTAL_""" is"_$S(Y<1:" *NOT*",1:"")_" installed.",IOM))
Q
SORRY(X) ;
KILL DIFQ
I X=3 S XPDQUIT=2 Q
S XPDQUIT=X
W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
Q
AUT98P26 ; IHS/OIT/FBD - AUT V98.1 PATCH 26 ENVIRONMENT CHECKS AND POST-INIT PROCESS;
+1 ;;98.1;IHS DICTIONARIES (POINTERS);**25**;FEB 9,2011;Build 6
+2 ;
+3 ;
+4 ; The following line prevents the "Disable Options..." and "Move Routines..." questions from being asked during the install.
+5 IF $GET(XPDENV)=1
SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+6 FOR X="XPO1","XPZ1","XPZ2","XPI1"
SET XPDDIQ(X)=0
+7 ;KERNEL
+8 IF +$$VERSION^XPDUTL("XU")<8
DO MES^XPDUTL($$CJ^XLFSTR("Version 8.0 of KERNEL is required. Not installed",80))
DO SORRY(2)
IF 1
+9 IF '$TEST
DO MES^XPDUTL($$CJ^XLFSTR("Requires Kernel Version 8.0....Present.",80))
+10 ;FILEMAN
+11 IF +$$VERSION^XPDUTL("DI")<22
DO MES^XPDUTL($$CJ^XLFSTR("Version 22.0 of FILEMAN is required. Not installed.",80))
DO SORRY(2)
IF 1
+12 IF '$TEST
DO MES^XPDUTL($$CJ^XLFSTR("Requires Fileman v22....Present.",80))
+13 ;AUT
+14 IF $$VERSION^XPDUTL("AUT")'="98.1"
DO MES^XPDUTL($$CJ^XLFSTR("Version 98.1 of the IHS DICTIONARIES (POINTERS) is required. Not installed",80))
DO SORRY(2)
IF 1
+15 IF '$TEST
DO MES^XPDUTL($$CJ^XLFSTR("Requires IHS DICTIONARIES (POINTERS) Version 98.1....Present.",80))
+16 ;AUT 98.1 PATCH 25
+17 IF '$$INSTALLD("AUT*98.1*25")
DO SORRY(2)
+18 ;
+19 ;CHECK IF PROVIDER TYPES IN '3P PROVIDER TAXONOMY' FILE MATCH PROPER PROVIDER CLASS CODES
+20 DO MES^XPDUTL($$CJ^XLFSTR("Valid provider classes required in 3P PROVIDER TAXONOMY file...",80))
+21 IF $$PTXSCAN
DO MES^XPDUTL($$CJ^XLFSTR("Invalid provider classes found in 3P PROVIDER TAXONOMY file.",80))
DO SORRY(2)
IF 1
+22 IF '$TEST
DO MES^XPDUTL($$CJ^XLFSTR("Provider classes in 3P PROVIDER TAXONOMY validate properly.",80))
+23 ;
+24 ;END OF ENVIRONMENT CHECK
QUIT
+25 ;
PRE ;PATCH 26 PRE-INIT CHECKS AND PROCESSES
+1 DO MES^XPDUTL($$CJ^XLFSTR("Beginning AUT v98.1 patch 26 pre-init process.",80))
+2 ;
+3 ;
+4 DO MES^XPDUTL($$CJ^XLFSTR("AUT v98.1 patch 26 pre-init process complete.",80))
+5 QUIT
+6 ;
PTXSCAN() ;PRE-SCAN OF PROVIDER TYPES SPECIFIED IN '3P PROVIDER TAXONOMY' FILE
+1 ;RETURN VALUE: 1 IF INVALID CODES DETECTED, 0 (ZERO) IF CLEAN
+2 NEW FLAG,PTXIEN,PRVCODE,PIECE,SPEC,MSG
+3 ;IF FLAG PASSES THROUGH SCAN UNAFFECTED, SCAN IS CLEAN
SET FLAG=0
+4 SET PTXIEN=0
+5 ;
FOR
SET PTXIEN=$ORDER(^ABMPTAX(PTXIEN))
IF '+PTXIEN
QUIT
Begin DoDot:1
+6 ;NODE PIECES FOR PROVIDER CLASS (#.02), PROVIDER CLASS 2 (#.04) AND PROVIDER CLASS 3 (#.05) FIELDS
FOR PIECE=2,4,5
Begin DoDot:2
+7 SET PRVCODE=$PIECE(^ABMPTAX(PTXIEN,0),U,PIECE)
IF PRVCODE=""
QUIT
+8 ;NO CORRESPONDING CODE FOUND IN 'D' XREF OF PROVIDER CLASS FILE, SO CODE IS INVALID
IF '+$ORDER(^DIC(7,"D",PRVCODE,""))
Begin DoDot:3
+9 SET FLAG=1
+10 SET SPEC=$SELECT(PIECE=4:" 2",PIECE=5:" 3",1:"")
+11 SET MSG="Record IEN "_PTXIEN_": invalid code "_PRVCODE_" found in PROVIDER CLASS"_SPEC_" field."
+12 DO MES^XPDUTL($$CJ^XLFSTR(MSG,80))
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT FLAG
+14 ;
POST ;PATCH 26 POST-INIT PROCESSES
+1 DO MES^XPDUTL($$CJ^XLFSTR("Beginning AUT v98.1 patch 26 post-init process.",80))
+2 ;
+3 ;POPULATE 'EDUCATION TOPICS' FILE'S NEW 'MAJOR TOPIC PTR' FIELD
DO MTPOP
+4 ;POPULATE 'INSURER' FILE'S NEW 'INSURER TYPE' FIELD
DO ITPOP
+5 ;UPDATE 'PROVIDER TAXONOMY' FILE -
DO PTXUP
+6 ;
+7 DO MES^XPDUTL($$CJ^XLFSTR("AUT v98.1 patch 26 post-init process complete.",80))
+8 QUIT
+9 ;
MTPOP ;EDUCATION MAJOR TOPICS FIELD POPULATION
+1 DO MES^XPDUTL($$CJ^XLFSTR("Populating EDUCATION TOPICS file / MAJOR TOPICS PTR field...",80))
+2 DO CVTALL^AUTEMTP
+3 DO MES^XPDUTL($$CJ^XLFSTR("EDUCATION TOPICS / MAJOR TOPICS PTR field population complete.",80))
+4 QUIT
+5 ;
ITPOP ;INSURER / INSURER TYPE FIELD POPULATION
+1 DO MES^XPDUTL($$CJ^XLFSTR("Populating INSURER file / INSURER TYPE field...",80))
+2 DO CVTALL^AUTCVIT
+3 DO MES^XPDUTL($$CJ^XLFSTR("INSURER / INSURER TYPE field population complete.",80))
+4 QUIT
+5 ;
PTXUP ;UPDATE 'PROVIDER TAXONOMY' WITH INFORMATION FROM '3P PROVIDER TAXONOMY'
+1 ;PROVIDER TAXONOMY ENTRIES WHICH MATCH TO 3P TAXONOMY ENTRIES ARE UPDATED WITH
+2 ;CORRESPONDING PROVIDER CLASS INFORMATION.
+3 NEW P3TXIEN,PTXIEN,NUCC,PERC,PRVC1,PRVC2,PRVC3,DA,DIE,DR
+4 SET PTXIEN=0
+5 ;SCANNING PROVIDER TAXONOMY
FOR
SET PTXIEN=$ORDER(^AUTTPTAX(PTXIEN))
IF '+PTXIEN
QUIT
Begin DoDot:1
+6 SET NUCC=$PIECE(^AUTTPTAX(PTXIEN,1),U,1)
+7 ;CORRESPONDING 3P PROVIDER TAXONOMY ENTRY
SET P3TXIEN=$ORDER(^ABMPTAX("B",NUCC,""))
IF P3TXIEN=""
QUIT
+8 ;PERSON CLASS
SET PERC=$PIECE(^ABMPTAX(P3TXIEN,0),U,3)
+9 ;PROVIDER CLASS
SET PRVC1=$PIECE(^ABMPTAX(P3TXIEN,0),U,2)
IF PRVC1'=""
SET PRVC1=+$ORDER(^DIC(7,"D",PRVC1,""))
+10 ;PROVIDER CLASS 2
SET PRVC2=$PIECE(^ABMPTAX(P3TXIEN,0),U,4)
IF PRVC2'=""
SET PRVC2=+$ORDER(^DIC(7,"D",PRVC2,""))
+11 ;PROVIDER CLASS 3
SET PRVC3=$PIECE(^ABMPTAX(P3TXIEN,0),U,5)
IF PRVC3'=""
SET PRVC3=+$ORDER(^DIC(7,"D",PRVC3,""))
+12 KILL DA,DIE,DR
SET DR=""
+13 SET DIE="^AUTTPTAX("
SET DA=PTXIEN
+14 IF +PERC
SET DR="3///`"_PERC
+15 IF +PRVC1
IF +$LENGTH(DR)
SET DR=DR_";"
SET DR=DR_"4.1///`"_PRVC1
+16 IF +PRVC2
IF +$LENGTH(DR)
SET DR=DR_";"
SET DR=DR_"4.2///`"_PRVC2
+17 IF +PRVC3
IF +$LENGTH(DR)
SET DR=DR_";"
SET DR=DR_"4.3///`"_PRVC3
+18 ;SKIP EDIT IF NOTHING TO TRANSFER
IF DR=""
QUIT
+19 DO ^DIE
KILL DA,DIE,DR
End DoDot:1
+20 ;
AUSC ;POST-UPDATE CLEANUP
+1 KILL DIK
+2 ;FLUSH POTENTIALLY CORRUPTED CROSS-REFERENCES
KILL ^AUTTPTAX("AUSC")
+3 ;IN PROVIDER TAXONOMY FILE
SET DIK="^AUTTPTAX("
+4 ;OF "PERSON CLASS" FIELD'S "AUSC" XREF
SET DIK(1)="3^AUSC"
+5 ;THEN REBUILD "AUSC" XREF FOR ALL XREFS
DO ENALL^DIK
+6 QUIT
+7 ;
INSTALLD(AUTSTAL) ;EP - Determine if patch AUTSTAL was installed, where
+1 ; AUTSTAL is the name of the INSTALL. E.g "AG*6.0*11".
+2 ;
+3 NEW AUTY,DIC,X,Y
+4 SET X=$PIECE(AUTSTAL,"*",1)
+5 SET DIC="^DIC(9.4,"
SET DIC(0)="FM"
SET D="C"
+6 DO IX^DIC
+7 IF Y<1
DO IMES
QUIT 0
+8 SET DIC=DIC_+Y_",22,"
SET X=$PIECE(AUTSTAL,"*",2)
+9 DO ^DIC
+10 IF Y<1
DO IMES
QUIT 0
+11 SET DIC=DIC_+Y_",""PAH"","
SET X=$PIECE(AUTSTAL,"*",3)
+12 DO ^DIC
+13 SET AUTY=Y
+14 DO IMES
+15 QUIT $SELECT(AUTY<1:0,1:1)
IMES ;
+1 DO MES^XPDUTL($$CJ^XLFSTR("Patch """_AUTSTAL_""" is"_$SELECT(Y<1:" *NOT*",1:"")_" installed.",IOM))
+2 QUIT
SORRY(X) ;
+1 KILL DIFQ
+2 IF X=3
SET XPDQUIT=2
QUIT
+3 SET XPDQUIT=X
+4 WRITE *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
+5 QUIT
