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

AG71A.m

Go to the documentation of this file. 
  1. AG71A ;IHS/SD/EFG - Patient Registration 7.1 POST INSTALL ;   
  1.  ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
  1.  ;
  1. PRE ;EP - From KIDS.
  1.  ;FILE 9009061.5 IS DINUMED AND HAS IDENTIFIERS. KIDS WILL NOT TRANSFER
  1.  ;NEW DTAT FOR THOSE FIELDS WIHTOUT FIRST KILLING THE GLOBAL DTAT FIRST.
  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.  D AGFAC
  1.  ;
  1.  D BMES^XPDUTL("Fixing private eligibility with missing .01 field."),TS
  1.  D PRVT
  1.  ;
  1.  D BMES^XPDUTL("Fixing Railroad Eligibility file with erroneous ""B"" cross reference"),TS
  1.  D RRE
  1.  ;
  1.  D BMES^XPDUTL("Fixing Medicaid eligibility with missing .01 field."),TS
  1.  D MCD
  1.  ;
  1.  D BMES^XPDUTL("Fixing Medicare eligibility B cross references."),TS
  1.  D MCR
  1.  ;
  1.  D BMES^XPDUTL("Fixing Medicaid sub file node counts."),TS
  1.  D ^AGMCDCNT
  1.  ;
  1.  D BMES^XPDUTL("Converting AUPNPAT field 3401 to a POINTER."),TS
  1.  D ^AGCNVMOD  ;CONVERT AUPNPAT FIELD 3401 TO A POINTER
  1.  ;
  1.  ;
  1.  ;CONVERT ENTRIES FROM .09 FIELD IN AUPNPAT TO
  1.  ;NEW 1201 MULTIPLE FIELD IN AUPNPAT
  1.  D BMES^XPDUTL("Converting AUPNPAT field .09 to new multiple field 1201."),TS
  1.  D ^AGCNVIMP
  1.  ;
  1.  ;CONVERT ENTRIES FROM OLD 'AUTO/LIABILITY' FILE
  1.  ;TO NEW 'THIRD PARTY LIABILITY' FILE
  1.  D BMES^XPDUTL("Converting AUTO/LIABILITY entries to new file."),TS
  1.  D ^AGCNVTPL
  1.  ;
  1.  ;CONVERT ENTRIES FROM OLD WORKMAN'S COMP FILE TO NEW WORKMAN'S
  1.  ;COMPENSATION FILE
  1.  D BMES^XPDUTL("Converting WORKMAN'S COMP entries to new file."),TS
  1.  D START^AGCNVWC
  1.  ;
  1.  ;CONVERT ENTRIES FROM FIELD 3301 IN AUPNPAT TO NEW
  1.  ;FILE AUPNBENR
  1.  D BMES^XPDUTL("Converting entries from AUPNPAT field 3301 to new file."),TS
  1.  D ^AGCNVBEN
  1.  ;
  1.  ;CONVERT ENTRIES IN .17 AND .18 IN AUPNPAT TO
  1.  ;NEW MULTIPLE FIELD 7101 IN AUPNPAT
  1.  D BMES^XPDUTL("Converting AUPNPAT fields .17 and .18 to new multiple field 7101."),TS
  1.  D ^AGCNVAOB
  1.  ;
  1.  ;POPULATE NEW 'MANDATORY FIELDS (SITE)' IN REGISTRATION PARAMETER
  1.  ;FILE
  1.  D BMES^XPDUTL("Populating mandatory site fields..."),TS
  1.  D ^AG71POST
  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)="UNPOPULATED STATE FIELDS IN MEDICAID ELIGIBILITY FILE"
  1.  S ^TMP("AG71MS",$J,4)="YOU WILL HAVE TO USE FILEMAN TO ENTER THE PROPER STATE INTO THIS FIELD"
  1.  S CNT=5
  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. AGFAC ;POPULATE NEW REGISTRATION PARAMETERS IF BLANK
  1.  S AGFAC=0
  1.  F  S AGFAC=$O(^AGFAC("B",AGFAC)) Q:'AGFAC  D
  1.  . S AGFACPTR=0
  1.  . F  S AGFACPTR=$O(^AGFAC("B",AGFAC,AGFACPTR)) Q:'AGFACPTR  D
  1.  .. I $P($G(^AGFAC(AGFACPTR,0)),U,22)="" S $P(^AGFAC(AGFACPTR,0),U,22)=0
  1.  .. I $P($G(^AGFAC(AGFACPTR,0)),U,23)="" S $P(^AGFAC(AGFACPTR,0),U,23)="N"
  1.  .. I $P($G(^AGFAC(AGFACPTR,0)),U,24)="" S $P(^AGFAC(AGFACPTR,0),U,24)="N"
  1.  .. I $P($G(^AGFAC(AGFACPTR,0)),U,25)="" S $P(^AGFAC(AGFACPTR,0),U,25)="N"
  1.  .. S AGVAL("TMP",1)="I CERTIFY THAT THE ABOVE INFORMATION IS ACCURATE TO THE BEST OF MY KNOWLEDGE."
  1.  .. S AGVAL("TMP",2)=" "
  1.  .. S AGVAL("TMP",3)="SIGNED: _____________________________________________  DATE: ______________"
  1.  .. S AGVAL("TMP",4)="        PATIENT/GUARDIAN/AUTHORIZED REPRESENTATIVE"
  1.  .. I '$D(^AGFAC(AGFACPTR,4,0)) D
  1.  ... D WP^DIE(9009061,AGFACPTR_",",40,,"AGVAL(""TMP"")")
  1.  K AGFAC,AGFACPTR,AGVAL
  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. 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.  .I $P($G(^AUPNMCD(RECNO,0)),U)="" K ^AUPNMCD(RECNO) Q  ;GET RID OF WHOLE THING INCLUDING SUBFILE
  1.  .;IF THE INS. PTR IS MISSING LETS FIX IT SO TPB CLAIMS GENERATOR DOESN'T BLOW UP
  1.  .I $P($G(^AUPNMCD(RECNO,0)),U,2)="" S DA=RECNO,DIE="^AUPNMCD(",DR=".02///3" D ^DIE
  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.  .S D1=0
  1.  .F  S D1=$O(^AUPNMCD(RECNO,11,D1)) Q:'D1  D
  1.  ..I $P($G(^AUPNMCD(RECNO,11,D1,0)),U)="" K ^AUPNMCD(RECNO,11,D1)
  1.  ;NOTE: MCD ELIGIBILITY HEADER FIXED IN ^AGMCDCNT
  1.  S DFN=""
  1.  F  S DFN=$O(^AUPNMCD("AB",DFN)) Q:DFN=""  D
  1.  .S ST="" F  S ST=$O(^AUPNMCD("AB",DFN,ST)) Q:ST=""  D
  1.  ..S MCDNUM="" F  S MCDNUM=$O(^AUPNMCD("AB",DFN,ST,MCDNUM)) Q:MCDNUM=""  D
  1.  ...S RECNO="" F  S RECNO=$O(^AUPNMCD("AB",DFN,ST,MCDNUM,RECNO)) Q:RECNO=""  D
  1.  ....I $P($G(^AUPNMCD(RECNO,0)),U)="" K ^AUPNMCD(RECNO),^AUPNMCD("AB",DFN,ST,MCDNUM,RECNO)
  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. 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