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

AG71A2.m

Go to the documentation of this file. 
  1. AG71A2 ;IHS/SD/EFG - Patient Registration 7.1 PATCH 2 PRE/POST INSTALL ;   
  1.  ;;7.1;PATIENT REGISTRATION;**2**;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 CHANGING 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.  ;DONE ONLY IF PATCH 1 NOT FOUND
  1.  I '$$PATCH("AG*7.1*1") D BMES^XPDUTL("Converting 'Release of Information' AUPNPAT field .04 to new multiple field 3601."),TS 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.  D BMES^XPDUTL("Fixing Policy Holder fields"),TS
  1.  D POLHOLD
  1.  ;
  1.  D BMES^XPDUTL("Cleaning ""C"" x-ref in Private Insurance File"),TS
  1.  D POLHCREF^AGDATA(,)
  1.  ;
  1.  D BMES^XPDUTL("Add File #2 VA PATIENT address fields as Site Mandatory field in the REGISTRATION PARAMETER file"),TS
  1.  D ADDMAN  ;ADD MANDATORY ADDRESS FIELDS IN FILE 2 TO REGISTRATION PARAMETER FILE
  1.  ;
  1.  ;D BMES^XPDUTL("Reindexing the new D x-ref in the PATIENT APPLICATION file"),TS
  1.  ;D REIN
  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. REIN ;INDEX THE 'PATIENT APPLICATIONS' FILE TO SET THE NEW "D" X-REF
  1.  ;SINCE THIS FILE WON'T BE THAT BIG. WE'LL JUST REINDEX EVERYTHING
  1.  ;this was placed into aupn9910.17k
  1.  K DIK
  1.  S DIK="^AUPNAPPS("
  1.  D IXALL^DIK
  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 Patch 2 has been installed into this uci ---"
  1.  S ^TMP("AG71MS",$J,2)=" "
  1.  S CNT=3
  1.  ;IHS/SD/TPF 4/19/2006 AG*7.1*2
  1.  ;REMOVE STATE MESSAGE. STATE CAN BE EDITED FROM EDIT SCREEN NOW
  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
  1.  ;FIX STATE,SEX AND DOB FIELDS WHICH WERE INCORRECTLY STUFFED
  1. POLHOLD ;
  1.  N IEN,DOB,STATE,SEX
  1.  S IEN=0
  1.  F  S IEN=$O(^AUPN3PPH(IEN)) Q:'IEN  D
  1.  .S STATE=$P($G(^AUPN3PPH(IEN,0)),U,12)
  1.  .S DOB=$P($G(^AUPN3PPH(IEN,0)),U,19)
  1.  .S SEX=$P($G(^AUPN3PPH(IEN,0)),U,8)
  1.  .Q:(STATE="")&(DOB="")&(SEX="")
  1.  .I STATE'="" D
  1.  ..Q:+STATE>0  ;DON'T DO ANYTHING IF ALREADY A POINTER
  1.  ..W !,IEN,"*",STATE
  1.  ..K DIC
  1.  ..S X=STATE
  1.  ..S DIC=5
  1.  ..D ^DIC
  1.  ..Q:Y<0
  1.  ..K DIE,DR,DIC,DA
  1.  ..S DA=IEN
  1.  ..S DIE="^AUPN3PPH("
  1.  ..S DR=".12///^S X=STATE"
  1.  ..D ^DIE
  1.  .I DOB'="" D
  1.  ..Q:DOB'["/"
  1.  ..W !,IEN,"*",DOB
  1.  ..K DIE,DR,DIC,DA
  1.  ..S DA=IEN
  1.  ..S DIE="^AUPN3PPH("
  1.  ..S DR=".19///^S X=DOB"
  1.  ..D ^DIE
  1.  .I SEX'="" D
  1.  ..Q:$L(SEX)=1
  1.  ..W !,IEN,"*",SEX
  1.  ..K DIE,DR,DIC,DA
  1.  ..S DA=IEN
  1.  ..S DIE="^AUPN3PPH("
  1.  ..S DR=".08///^S X=SEX"
  1.  ..D ^DIE
  1.  Q
  1. PATCH(X) ;return 1 if patch X was installed, X=aaaa*nn.nn*nnnn
  1.  Q:X'?1.4UN1"*"1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.4N 0
  1.  N %,I,J
  1.  S I=$O(^DIC(9.4,"C",$P(X,"*"),0)) Q:'I 0
  1.  S J=$O(^DIC(9.4,I,22,"B",$P(X,"*",2),0)),X=$P(X,"*",3) Q:'J 0
  1.  ;check if patch is just a number
  1.  Q:$O(^DIC(9.4,I,22,J,"PAH","B",X,0)) 1
  1.  S %=$O(^DIC(9.4,I,22,J,"PAH","B",X_" SEQ"))
  1.  Q (X=+%)
  1.  ;ADD CORRECT MANDATORY ADDRESS FIELDS FOR VA PATIENT
  1. ADDMAN ;
  1.  K DA,DIC,DIE,DR,DO,DD,DINUM
  1.  S DUZ2=0
  1.  F  S DUZ2=$O(^AGFAC(DUZ2)) Q:'DUZ2  D
  1.  .S DA(1)=$O(^AGFAC(DUZ2,11,"B",2,""))  ;JUST DO THIS FOR 'VA PATIENT' FILE
  1.  .;S DUZ2=516,DA(1)=1
  1.  .Q:'DA(1)
  1.  .S DA(2)=DUZ2
  1.  .S DIC="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
  1.  .S X="STATE"
  1.  .S DIC(0)="LX"
  1.  .S DIC("DR")=".02///^S X=0"
  1.  .D ^DIC
  1.  .S X="ZIP CODE"
  1.  .S DIC(0)="LX"
  1.  .S DIC("DR")=".02///^S X=0"
  1.  .D ^DIC
  1.  .S X="CITY"
  1.  .S DIC(0)="LX"
  1.  .S DIC("DR")=".02///^S X=0"
  1.  .D ^DIC
  1.  .S X="STREET ADDRESS [LINE 1]"
  1.  .D ^DIC
  1.  Q
  1.  ;FIX DANGLING "c" X-REF WITH NO POLICY HOLDER IN 11 NODE
  1. POL ;
  1.  S POLH="" F  S POLH=$O(^AUPNPRVT("C",POLH)) Q:POLH=""  D
  1.  .S POLM="" F  S POLM=$O(^AUPNPRVT("C",POLH,POLM)) Q:POLM=""  D
  1.  ..S REC="" F  S REC=$O(^AUPNPRVT("C",POLH,POLM,REC)) Q:REC=""  D
  1.  ...I $P($G(^AUPNPRVT(POLM,11,REC,0)),U,8)'=POLH D
  1.  ....W !,POLM,"**",REC,!?5,"POLH:",POLH
  1.  ....W !?5,"PIECE 8:",$P($G(^AUPNPRVT(POLM,11,REC,0)),U,8)
  1.  ....I $P($G(^AUPNPRVT(POLM,11,REC,0)),U,8)="" W !?5,"INSURER NODE:",$G(^AUPNPRVT(POLM,11,REC,0))
  1.  ....I $P($G(^AUPNPRVT(POLM,11,REC,0)),U,8)="",($G(^AUPNPRVT(POLM,11,REC,0))="") K ^AUPNPRVT("C",POLH,POLM,REC)