Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AUT98P26

AUT98P26.m

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