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

AG71A1.m

Go to the documentation of this file. 
  1. AG71A1 ;IHS/SD/EFG - Patient Registration 7.1 PATCH 1 PRE/POST INSTALL ;   
  1.  ;;7.1;PATIENT REGISTRATION;**1**;AUG 25,2005
  1.  ;
  1.  Q
  1. PRE ;EP - From KIDS.
  1.  ;'AG PATIENT REGISTRATION ERROR CODES' FILE
  1.  ;FILE 9009061.5 IS DINUMED AND HAS IDENTIFIERS. KIDS WILL NOT TRANSFER
  1.  ;NEW DATA FOR THOSE FIELDS WITHOUT FIRST KILLING THE GLOBAL DATA FIRST.
  1.  ;ONLY NEED IF CHAGING DATA IN THIS FILE
  1.  S IEN="" F  S IEN=$O(^AGEDERRS(IEN)) Q:IEN=""  K ^AGEDERRS(IEN)
  1.  Q
  1. POST ;EP - From KIDS.
  1.  D BMES^XPDUTL("Beginning post-install routine (POST^AG71A)."),TS
  1.  ;
  1.  ;CONVERT ENTRIES IN .04 IN AUPNPAT TO
  1.  ;NEW MULTIPLE FIELD 3601 IN AUPNPAT
  1.  D BMES^XPDUTL("Converting 'Release of Information' AUPNPAT field .04 to new multiple field 3601."),TS
  1.  D ^AGCNVROI
  1.  ;
  1.  D BMES^XPDUTL("Fixing private eligibility with missing Policy Holder .08 field. or missing insurer pointer"),TS
  1.  D PRVT
  1.  ;
  1.  D BMES^XPDUTL("Collecting Medicaid eligibility entries with missing State .04 field."),TS
  1.  D MCD
  1.  ;
  1.  D BMES^XPDUTL("Fixing Medicare eligibility B cross references."),TS
  1.  D MCR
  1.  ;
  1.  ;CAN WE INCLUDE THIS IN AG PATCH 1
  1.  D BMES^XPDUTL("Fixing INSUREr IENs containing decimal."),TS
  1.  D INSURER
  1.  ;
  1.  D BMES^XPDUTL("Fixing Medicare records with missing .01 fields"),TS
  1.  D MCR
  1.  ;
  1.  D BMES^XPDUTL("Fixing Rail Road entries with missing .01 field."),TS
  1.  D RRE
  1.  ;
  1.  D BMES^XPDUTL("Fixing incomplete Guarantor records."),TS
  1.  D GUAR
  1.  ;
  1.  D BMES^XPDUTL("Fixing patient file with dangling D x-ref"),TS
  1.  D PAT
  1.  ;
  1.  I $$INSTALLD^AG71ENV("AG*7.1") D
  1.  . D TS,BMES^XPDUTL("Delivering AG*7.1 install message to select users ...")
  1.  . D MAIL
  1.  . D BMES^XPDUTL("Post-install routine is complete."),TS
  1.  ;
  1.  Q:$$INSTALLD^AG71ENV("AG*7.1")
  1.  ;
  1.  D TS,OPTRES("AGMENU")
  1.  ;
  1.  D TS,BMES^XPDUTL("Delivering AG*7.1 install message to select users...")
  1.  ;
  1.  D MAIL
  1.  ;
  1.  D BMES^XPDUTL("Post-install routine is complete."),TS
  1.  Q
  1. MAIL ;Send install mail message.
  1.  N DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
  1.  K ^TMP("AG71MS",$J)
  1.  S ^TMP("AG71MS",$J,1)=" --- AG v 7.1 has been installed into this uci ---"
  1.  S ^TMP("AG71MS",$J,2)=" "
  1.  S ^TMP("AG71MS",$J,3)="PLEASE REPORT TO THE OIT HELP DESK THE FOLLOWING"
  1.  S ^TMP("AG71MS",$J,4)="UNPOPULATED STATE FIELDS IN MEDICAID ELIGIBILITY FILE"
  1.  S ^TMP("AG71MS",$J,5)="YOU WILL HAVE TO USE FILEMAN TO ENTER THE PROPER STATE INTO THIS FIELD"
  1.  S CNT=6
  1.  D STATEMSG(.AGERRLST,.CNT)
  1.  K AGERRLST
  1.  S %=0
  1.  F  S %=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%)) Q:'%   S ^TMP("AG71MS",$J,(%+CNT))=" "_^(%,0)
  1.  S XMSUB=$P($P($T(+1),";",2)," ",3,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""AG71MS"",$J,",XMY(1)="",XMY(DUZ)=""
  1.  F %="AGZMENU","XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
  1.  D ^XMD
  1.  K ^TMP("AG71MS",$J)
  1.  Q
  1. SINGLE(K) ;EP - Get holders of a single key K.
  1.  N Y
  1.  S Y=0
  1.  Q:'$D(^XUSEC(K))
  1.  F  S Y=$O(^XUSEC(K,Y)) Q:'Y  S XMY(Y)=""
  1.  Q
  1.  ;
  1. OPTRES(AGM) ;
  1.  D BMES^XPDUTL("Restoring '"_AGM_"' option to PRE-install configuration...")
  1.  NEW AG,AGI
  1.  I '$D(^XTMP("AG71",7.2,"OPTSAV",AGM)) D BMES^XPDUTL("FAILED.  Option '"_AGM_"' was not previously saved.") Q
  1.  S AG=0
  1.  F  S AG=$O(^XTMP("AG71",7.2,"OPTSAV",AGM,AG)) Q:'AG  S AGI=^(AG) I '$$ADD^XPDMENU(AGM,$P(AGI,U),$P(AGI,U,2),$P(AGI,U,3)) D BMES^XPDUTL("....FAILED to re-attach "_$P(AGI,U)_" to "_AGM_".")
  1.  ;D BMES^XPDUTL("Attaching ""RHI1"" option to the Registration Reports menu ""RPT"".")
  1.  ;I $$ADD^XPDMENU("AGREPORTS","AGRHI1","RHI1",20) D BMES^XPDUTL("....successfully atch'd.") I 1
  1.  ;E  D BMES^XPDUTL("....Attachment *FAILED*.")
  1.  Q
  1. TS D MES^XPDUTL($$HTE^XLFDT($H)) Q
  1. MCD ;CLEAR MCD RECORDS MISSING .01 FIELD
  1.  ;MUST DO DIRECT KILL BECAUSE X-REF NOT THERE. BOMBS ON USE OF ^DIK
  1.  K AGERRLST
  1.  N HRN,DFN,ST,MCDNUM
  1.  S RECNO=0
  1.  F  S RECNO=$O(^AUPNMCD(RECNO)) Q:'RECNO  D
  1.  .;IF THE INS. PTR IS MISSING LETS FIX IT SO TPB CLAIMS GENERATOR DOESN'T BLOW UP
  1.  .I '$G(^AUPNMCD(RECNO,0))!('$P($G(^AUPNMCD(RECNO,0)),U)) K ^AUPNMCD(RECNO) Q
  1.  .I $P($G(^AUPNMCD(RECNO,0)),U,4)="" S DFN=$P($G(^AUPNMCD(RECNO,0)),U),AGERRLST(RECNO)=$P($G(^DPT(DFN,0)),U)_U_$P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)
  1.  Q
  1. RRE ;FIX "B" X-REF ENTRIES WITH NO ZERO RECORD
  1.  ;MUST DO DIRECT KILL BECAUSE RECORD NOT THERE. BOMBS ON USE OF ^DIK DOESN'T WORK
  1.  S RECNO=""
  1.  F  S RECNO=$O(^AUPNRRE("B",RECNO)) Q:'RECNO  D
  1.  .I $P($G(^AUPNRRE(RECNO,0)),U)="" K ^AUPNRRE(RECNO),^AUPNRRE("B",RECNO)
  1.  S RECNO=0
  1.  F  S RECNO=$O(^AUPNRRE(RECNO)) Q:'RECNO  D
  1.  .I $P($G(^AUPNRRE(RECNO,0)),U)="" K ^AUPNRRE(RECNO),^AUPNRRE("B",RECNO)
  1.  Q
  1. MCR ;
  1.  S RECNO=""
  1.  F  S RECNO=$O(^AUPNMCR("B",RECNO)) Q:'RECNO  D
  1.  .I $P($G(^AUPNMCR(RECNO,0)),U)="" K ^AUPNMCR(RECNO),^AUPNMCR("B",RECNO)
  1.  S RECNO=0
  1.  F  S RECNO=$O(^AUPNMCR(RECNO)) Q:'RECNO  D
  1.  .I $P($G(^AUPNMCR(RECNO,0)),U)="" K ^AUPNMCR(RECNO),^AUPNMCR("B",RECNO)
  1.  Q
  1. INSURER ;EP - CAN WE INCLUDE THIS IN AG PATCH 1??
  1.  S RECNO=0
  1.  F  S RECNO=$O(^AUTNINS(RECNO)) Q:'RECNO  D
  1.  .I RECNO[(".") K ^AUTNINS(RECNO),^AUTNINS("B",RECNO)
  1.  S RECNO=""
  1.  F  S RECNO=$O(^AUTNINS("B",RECNO)) Q:RECNO=""  D
  1.  .S RECIEN=""
  1.  .F  S RECIEN=$O(^AUTNINS("B",RECNO,RECIEN)) Q:RECIEN=""  D
  1.  ..Q:$P($G(^AUTNINS(RECIEN,0)),U)'=""
  1.  ..K DA,DIR,DIE,DIK,DIC,DR
  1.  ..S DA=RECIEN,DIK="^AUTNINS(" D ^DIK
  1.  Q
  1. PAT ;CLEAN UP D X-REF IN PATIENT FILE
  1.  S HRN="" F  S HRN=$O(^AUPNPAT("D",HRN)) Q:HRN=""  D
  1.  .S RECNO="" F  S RECNO=$O(^AUPNPAT("D",HRN,RECNO)) Q:RECNO=""  D
  1.  ..I '$D(^AUPNPAT(RECNO))!('$D(^DPT(RECNO))) K ^AUPNPAT("D",HRN,RECNO)
  1.  Q
  1. PRVT ;CLEAR ANY PRIVATE ELIG RECORDS MISSING INSURER POINTER
  1.  ;MUST DO DIRECT KILL BECAUSE X-REF NOT THERE. BOMBS ON USE OF ^DIK
  1.  S RECNO=0
  1.  F  S RECNO=$O(^AUPNPRVT(RECNO)) Q:'RECNO  D
  1.  .S D1=0
  1.  .F  S D1=$O(^AUPNPRVT(RECNO,11,D1)) Q:'D1  D
  1.  ..I $P($G(^AUPNPRVT(RECNO,11,D1,0)),U)="" K ^AUPNPRVT(RECNO,11,D1) Q
  1.  ..I $P($G(^AUPNPRVT(RECNO,11,D1,0)),U,8)="" S DA=D1,DA(1)=RECNO,DIK="^AUPNPRVT("_DA(1)_",11," D ^DIK
  1.  ..I $O(^AUPNPRVT(RECNO,11,0)) Q
  1.  ..S DA=RECNO,DIK="^AUPNPRVT(" D ^DIK
  1.  S RECNO=0 F  S RECNO=$O(^AUPNPRVT("B",RECNO)) Q:RECNO=""  D
  1.  .S IEN=0 F  S IEN=$O(^AUPNPRVT("B",RECNO,IEN)) Q:'IEN  D
  1.  ..I $P($G(^AUPNPRVT(IEN,0)),U)="" K ^AUPNPRVT(IEN),^AUPNPRVT("B",RECNO,IEN)
  1.  Q
  1. GUAR ;CLEAR GUARANTOR RECORDS WITH INCOMPETE ENTRIES
  1.  N PATPTR
  1.  S PATPTR=0
  1.  F  S PATPTR=$O(^AUPNGUAR(PATPTR)) Q:'PATPTR  D GUAR1(PATPTR)
  1.  Q
  1. GUAR1(PATPTR) ;EP - DELETE GUARANTOR ENTRIES WITH MISSING GUARANTORS OR DATES
  1.  N SUB1,SUB11,REDO
  1. REDO ;
  1.  S SUB1=$O(^AUPNGUAR(PATPTR,1,0))
  1.  I 'SUB1 D  Q  ;NO GUARANTORS FOUND AT ALL
  1.  .K DIE,DIK,DA,DIC S DIK="^AUPNGUAR(",DA=PATPTR D ^DIK
  1.  ;FOR EACH GUARANTOR ARE THERE EFFECTIVE DATES?
  1.  S (SUB1,REDO)=0
  1.  F  S SUB1=$O(^AUPNGUAR(PATPTR,1,SUB1)) Q:'SUB1  D  G REDO:REDO
  1.  .S SUB11=$O(^AUPNGUAR(PATPTR,1,SUB1,11,0))
  1.  .I 'SUB11 D  Q
  1.  ..S REDO=1 K DIE,DIK,DA,DIC S DA(1)=PATPTR,DA=SUB1,DIK="^AUPNGUAR("_DA(1)_",1," D ^DIK
  1.  Q
  1. STATEMSG(ARRAY,LN) ;EP - SEND MSG ABOUT MEDICAID ENTRIES MISSING STATE FIELD
  1.  N IEN
  1.  S IEN=""
  1.  F LN=LN:1 S IEN=$O(ARRAY(IEN)) Q:IEN=""  D
  1.  .S ^TMP("AG71MS",$J,LN)="HRN # "_$P(ARRAY(IEN),U,2)_" IS MISSIING THE STATE FIELD IN MEDICAID ELIGIBILITY ENTRY "_IEN
  1.  Q
  1. VAALERT ;EP - SEND VA ALERT IF WANTED
  1.  S XQAMSG="Patient Regsistration "_$P($T(+2),";",3)_" Patch "_$P($T(+2),";",5)_" INSTALL complete."
  1.  S XQA("AG MAIL GROUP")=""
  1.  D SETUP^XQALERT
  1.  Q