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

AG6P17B.m

Go to the documentation of this file. 
  1. AG6P17B ;IHS/ASDST/GTH - Patient Registration 6.0 Patch 17 CONT. ; 
  1.  ;;7.0;IHS PATIENT REGISTRATION;;MAR 28, 2003
  1.  ;
  1.  ; IHS/SET/GTH AG*6*17 10/01/2002
  1.  ;
  1. P17 ;EP -- Update EXIT ACTION of AGMENU to call AG^AGHL7.
  1.  ;;D AG^AGHL7,PHDR^AG,KILL^AG I $D(AGSADUZ2) S DUZ(2)=AGSADUZ2 K AGSADUZ2
  1.  ;
  1.  NEW DA,DIE,DR
  1.  S DA=""
  1.  F  S DA=$O(^DIC(19,"B","AGMENU",DA)) Q:DA=""  D
  1.  . Q:^DIC(19,DA,15)=$P($T(P17+1),";",3)
  1.  . S DIE="^DIC(19,",DR="15///"_$P($T(P17+1),";",3)
  1.  . D ^DIE
  1.  .Q
  1.  Q
  1.  ;
  1. INDXC ;EP - Index "C" x-ref on Elig. Upload log file.
  1.  D BMES^XPDUTL("Indexing new 'C' x-ref on ELIGIBILITY UPLOAD LOG file...")
  1.  NEW DIK
  1.  S DIK="^AGELUPLG(",DIK(1)=".03^C"
  1.  D ENALL^DIK
  1.  D MES^XPDUTL("Index of 'C' complete.")
  1.  Q
  1.  ;
  1. COVIT ;EP - Check MCD Coverage Types.
  1.  D BMES^XPDUTL("Checking Medicaid Coverage Types.")
  1.  ;
  1.  KILL ^TMP("AG6P17B",$J)
  1.  ;
  1.  D RSLT("The following Patients have bad Coverage Type values in their")
  1.  D RSLT("Medicaid Eligibility information.  This was caused by a bug")
  1.  D RSLT("present for many years.  The value of the Coverage Type(s) can")
  1.  D RSLT("be corrected by editing the Patient's Medicaid information on")
  1.  D RSLT("Patient Registration, Page 5."),RSLT(" ")
  1.  D RSLT("  ( To re-run the report:  D COVIT^AG6P17B )  .")
  1.  D RSLT($J("PATIENT",20)_$J("HRN",8)_"  MEDICAID #"_"  ELIG. DATE    COVERAGE TYPE")
  1.  D RSLT("--------------------  ------  ----------  ------------  -------------")
  1.  ;
  1.  NEW AGD2,AGD2,AGD1,AGIT,DFN
  1.  ;
  1.  S AGIT=$P(^DD(9000004.11,.03,0),U,5,99)
  1.  F AGD2=0:0 S AGD2=$O(^AUPNMCD(AGD2)) Q:'AGD2  D
  1.  . F AGD1=0:0 S AGD1=$O(^AUPNMCD(AGD2,11,AGD1)) Q:'AGD1  D
  1.  .. S X=$P(^AUPNMCD(AGD2,11,AGD1,0),U,3)
  1.  .. Q:'$L(X)
  1.  .. X AGIT
  1.  .. Q:$D(X)
  1.  .. S DFN=$P(^AUPNMCD(AGD2,0),U)
  1.  .. D RSLT($J($P(^DPT(DFN,0),U,1),20)_$J($P($G(^AUPNPAT(DFN,41,DUZ(2),0),"??"),U,2),8)_$J($P(^AUPNMCD(AGD2,0),U,3),12)_"  "_$$FMTE^XLFDT(AGD1)_"  '"_$P(^AUPNMCD(AGD2,11,AGD1,0),U,3)_"'")
  1.  ..Q
  1.  .Q
  1.  ;
  1.  D MES^XPDUTL("Sending e-mail to local data entry person(s).")
  1.  ;
  1.  NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
  1.  S XMSUB="** Report Bad Medicaid Coverage Types **",XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""AG6P17B"",$J,",XMY(1)="",XMY(DUZ)=""
  1.  F %="AGZMENU","ABMDZ ELIGIBILITY EDIT","XUMGR","XUPROG","XUPROGMODE" D SINGLE^AG6P17A(%)
  1.  D ^XMD
  1.  KILL ^TMP("AG6P17B",$J)
  1.  ;
  1.  D MES^XPDUTL("...Done.")
  1.  Q
  1.  ;
  1. RSLT(%) S ^(0)=$G(^TMP("AG6P17B",$J,0))+1,^(^(0))=% D MES^XPDUTL(%)
  1.  Q
  1.  ;
  1. AGTX ;EP - Remove options from AGTX menu.
  1.  D BMES^XPDUTL("Removing ""AG TX CONFIG"" and ""AGTXALL"" option from export menu ""AGTX"".")
  1.  D MES^XPDUTL("These are the ""CONF"" and ""ALL"" options used for the NPIRS re-load.")
  1.  NEW AGOPT,DIK,DA,X
  1.  S DA(1)=$O(^DIC(19,"B","AGTX",0))
  1.  I 'DA(1) D MES^XPDUTL("...Option 'AGTX' not found in file 19:  ERROR.")
  1.  I DA(1) F AGOPT="AG TX CONFIG","AGTXALL" D
  1.  . S DA=$O(^DIC(19,"B",AGOPT,0))
  1.  . I 'DA(1) D MES^XPDUTL("...Option '"_AGOPT_"' not found in file 19:  ERROR.") Q
  1.  . S DA=$O(^DIC(19,DA(1),10,"B",DA,0))
  1.  . I 'DA D MES^XPDUTL("...Option '"_AGOPT_"' wasn't atch'd to 'AGTX'.  That's OK.") Q
  1.  . S DIK="^DIC(19,DA(1),10,"
  1.  . D ^DIK
  1.  . D MES^XPDUTL("Option '"_AGOPT_"' removed from 'AGTX'.")
  1.  .Q
  1.  D MES^XPDUTL("...Done.")
  1.  Q
  1.  ;
  1. DELR ;EP - Delete unneeded AGTXX* and AGTXZ* routines.
  1.  D BMES^XPDUTL("Deleting unneeded AGTXX* and AGTXZ* routines.")
  1.  KILL ^TMP("AG6P17B",$J)
  1.  I $$RSEL^ZIBRSEL("AGTXX*","^TMP(""AG6P17B"","_$J_",") D DEL
  1.  I $$RSEL^ZIBRSEL("AGTXZ*","^TMP(""AG6P17B"","_$J_",") D DEL
  1.  D MES^XPDUTL("...Done.")
  1.  Q
  1. DEL ;
  1.  NEW X
  1.  S X=""
  1.  F  S X=$O(^TMP("AG6P17B",$J,X)) Q:X=""  X ^%ZOSF("DEL")  I $G(XPDA) D MES^XPDUTL(X_$E("...........",1,11-$L(X))_"<poof'd>")
  1.  KILL ^TMP("AG6P17B",$J)
  1.  Q
  1.  ;
  1. EV ;EP - Process 270/271 components.
  1.  D BMES^XPDUTL("Processing 270/271 fields/components.")
  1.  D MES^XPDUTL("Updating Eligibility Checking Period.")
  1.  NEW DR
  1.  I $G(XPDQUES("POS1")) D  I 1
  1.  . NEW DA,DIC,DIE,DR
  1.  . S DA=DUZ(2),DIE="^AGFAC(",DR="35///"_XPDQUES("POS1")
  1.  . D ^DIE
  1.  . D MES^XPDUTL("...parameter updated.")
  1.  .Q
  1.  E  D MES^XPDUTL("***error: Could not find parameter in post-install.")
  1.  ;
  1.  D MES^XPDUTL("Attaching the '270/271 processing' menu to the 'Eligibility' menu.")
  1.  I $$ADD^XPDMENU("AG TM ELIGIBILITY","AGEV MENU","ECHK") D MES^XPDUTL("....successfully atch'd."),MES^XPDUTL("NOTE:  Security Key *NOT* allocated.") I 1
  1.  E  D BMES^XPDUTL("....Attachment *FAILED*.")
  1.  D MES^XPDUTL("End Processing 270/271 fields/components.")
  1.  Q
  1.  ;