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

AG71A9.m

Go to the documentation of this file.
  1. AG71A9 ;VNGT/HS/BEE - Patient Registration 7.1 PATCH 9 POST INSTALL ; MAY 07, 2010
  1. ;;7.1;PATIENT REGISTRATION;**9**;AUG 25, 2005
  1. ;
  1. Q
  1. ;
  1. POST ;EP - From KIDS.
  1. ;
  1. N CLBEN,MMSG,IEN,AMIND
  1. D TS,BMES^XPDUTL("Beginning post-install routine (POST^AG71A9).")
  1. ;
  1. S MMSG=" --- AG v 7.1 Patch 9 has been installed into this uci --- "
  1. ;
  1. ;Set new 'LINK AOB TO ROI FIELD' to default of 'NO'
  1. ;and define new facility parameter ROI/AOB required prompts
  1. W !
  1. S IEN=0 F S IEN=$O(^AGFAC(IEN)) Q:'IEN D
  1. . ;
  1. . ;Set up new ETHNICITY INFORMATION Required registration parameter prompt
  1. . D ETHN^AG71A9(IEN)
  1. . ;
  1. . ;Set up new RACE Required registration parameter prompt
  1. . D RACE^AG71A9(IEN)
  1. . ;
  1. . ;Set up new PREFERRED LANGUAGE Required registration parameter prompt
  1. . D PREF^AG71A9(IEN)
  1. . ;
  1. . ;Set up new PRIMARY LANGUAGE Required registration parameter prompt
  1. . D PRIM^AG71A9(IEN)
  1. . ;
  1. . ;Set up Homeless and Migrant prompts with default of no
  1. . D HOM^AG71A9(IEN)
  1. ;
  1. ;Remove the lock from the AGSETSITE option
  1. N DIC,X,Y S DIC="^DIC(19,",X="AGSETSITE"
  1. D ^DIC
  1. I +Y>0 D
  1. . N DA,DIC,DIE,DR,X
  1. . S DA=+Y
  1. . S DIE="^DIC(19,"
  1. . S DR="3////@"
  1. . D ^DIE
  1. K DIC,X,Y
  1. ;
  1. ;Populate Race field based on CLASSIFICATION/BENEFICIARY
  1. D TS,BMES^XPDUTL("AutoPopulating PATIENT RACE field (POST^AG71A9).")
  1. S CLBEN=$O(^AUTTBEN("B","INDIAN/ALASKA NATIVE","")) ;Get Classification IEN
  1. S AMIND=$O(^DIC(10,"B","AMERICAN INDIAN OR ALASKA NATIVE","")) ;Get Amer/Ind IEN
  1. ;
  1. I CLBEN]"",AMIND]"" D
  1. . N DFN,X,ERROR
  1. . S DFN=0 F S DFN=$O(^DPT(DFN)) Q:'DFN D
  1. .. ;
  1. .. ;Quit if CLASSIFICATION/BENEFICIARY not equal to INDIAN/ALASKA NATIVE
  1. .. Q:$$GET1^DIQ(9000001,DFN_",",1111,"I")'=CLBEN
  1. .. ;
  1. .. ;Update RACE
  1. .. K DA,DIC,X,Y
  1. .. N DA,DIE,DR
  1. .. S DA=DFN
  1. .. S DIE="^DPT("
  1. .. S DR=".06////"_AMIND
  1. .. D ^DIE
  1. ;
  1. D TS,BMES^XPDUTL("Delivering v 7.1 Patch 9 install message to select users...")
  1. ;
  1. ;Deliver Mail Message
  1. D MAIL(MMSG)
  1. ;
  1. D TS,BMES^XPDUTL("AG v 7.1 Patch 9 Post-install is complete.")
  1. Q
  1. ;
  1. MAIL(MMSG) ;Send install mail message.
  1. N %,CNT,DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
  1. K ^TMP("AG71MS",$J)
  1. S ^TMP("AG71MS",$J,1)=$G(MMSG)
  1. S ^TMP("AG71MS",$J,2)=" "
  1. S CNT=3
  1. ;
  1. S %=0
  1. Q:$G(XPDA)=""
  1. Q:$G(XPDBLD)=""
  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. TS D MES^XPDUTL($$HTE^XLFDT($H)) Q
  1. ;
  1. HOM(FAC) ;Set Homeless and Migrant Display parameters
  1. ;
  1. N VAL
  1. ;
  1. ;Homeless Display
  1. S VAL=$$GET1^DIQ(9009061,FAC_",",28) I VAL="" D
  1. . ;
  1. . ;Set the display to "YES"
  1. . K DA,DIC,X,Y
  1. . N DA,DIE,DR
  1. . S DA=FAC
  1. . S DIE="^AGFAC("
  1. . S DR="28////Y"
  1. . D ^DIE
  1. ;
  1. ;Migrant Display
  1. S VAL=$$GET1^DIQ(9009061,FAC_",",27) I VAL="" D
  1. . ;
  1. . ;Set the display to "YES"
  1. . K DA,DIC,X,Y
  1. . N DA,DIE,DR
  1. . S DA=FAC
  1. . S DIE="^AGFAC("
  1. . S DR="27////Y"
  1. . D ^DIE
  1. ;
  1. Q
  1. ;
  1. ETHN(FAC) ;Now add the ETHNICITY field
  1. ;
  1. N PRFIEN,DA,DIC,FLIEN,X,Y
  1. ;
  1. ;First Look for existing 2 entry
  1. S DA(1)=FAC
  1. S DIC="^AGFAC("_FAC_",11,"
  1. S DIC(0)="L"
  1. S X="2"
  1. D ^DIC
  1. Q:Y'>0
  1. S FLIEN=+Y
  1. ;
  1. ;Quit if ETHNICITY INFORMATION already defined
  1. I $O(^AGFAC(FAC,11,FLIEN,1,"B","ETHNICITY INFORMATION",""))]"" Q
  1. ;
  1. ;Now add the ETHNICITY field
  1. W !
  1. K DA,DIE,DR
  1. N DA,DIC,X,Y
  1. S DA(2)=FAC,DA(1)=FLIEN
  1. S DIC="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
  1. S DIC(0)="LS"
  1. S X="6"
  1. D ^DIC
  1. S PRFIEN=+Y
  1. I +PRFIEN W " REQUIRED? parameter added for site: ",$$GET1^DIQ(9999999.06,FAC_",",.01,"E")
  1. ;
  1. ;Set the required value to NO
  1. K DA,DIC,X,Y
  1. N DA,DIE,DR
  1. S DA(2)=FAC,DA(1)=FLIEN,DA=PRFIEN
  1. S DIE="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
  1. S DR=".02////0"
  1. D ^DIE
  1. Q
  1. ;
  1. RACE(FAC) ;Now add the RACE field
  1. ;
  1. N PRFIEN,DA,DIC,FLIEN,X,Y
  1. ;
  1. ;First Look for existing 2 entry
  1. S DA(1)=FAC
  1. S DIC="^AGFAC("_FAC_",11,"
  1. S DIC(0)="L"
  1. S X="2"
  1. D ^DIC
  1. Q:Y'>0
  1. S FLIEN=+Y
  1. ;
  1. ;Quit if RACE already defined
  1. I $O(^AGFAC(FAC,11,FLIEN,1,"B","RACE",""))]"" Q
  1. ;
  1. ;Now add the RACE field
  1. W !
  1. K DA,DIE,DR
  1. N DA,DIC,X,Y
  1. S DA(2)=FAC,DA(1)=FLIEN
  1. S DIC="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
  1. S DIC(0)="LS"
  1. S X=".06"
  1. D ^DIC
  1. S PRFIEN=+Y
  1. I +PRFIEN W " REQUIRED? parameter added for site: ",$$GET1^DIQ(9999999.06,FAC_",",.01,"E")
  1. ;
  1. ;Set the required value to NO
  1. K DA,DIC,X,Y
  1. N DA,DIE,DR
  1. S DA(2)=FAC,DA(1)=FLIEN,DA=PRFIEN
  1. S DIE="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
  1. S DR=".02////0"
  1. D ^DIE
  1. ;
  1. Q
  1. ;
  1. PREF(FAC) ;Add PREFERRED LANGUAGE to facility required field list
  1. ;
  1. N PRFIEN,DA,DIC,FLIEN,X,Y
  1. ;
  1. ;First Look for existing 9000001 entry
  1. S DA(1)=FAC
  1. S DIC="^AGFAC("_FAC_",11,"
  1. S DIC(0)="L"
  1. S X="9000001"
  1. D ^DIC
  1. Q:Y'>0
  1. S FLIEN=+Y
  1. ;
  1. ;Quit if PREFERRED LANGUAGE already defined
  1. I $O(^AGFAC(FAC,11,FLIEN,1,"B","PREFERRED LANGUAGE",""))]"" Q
  1. ;
  1. ;Now change the file to 9000001.86 so it can pass input transform check
  1. K DA,DIC,X,Y
  1. N DA,DIE,DR
  1. S DA(1)=FAC,DA=FLIEN
  1. S DIE="^AGFAC("_DA(1)_",11,"
  1. S DR=".01////9000001.86"
  1. D ^DIE
  1. ;
  1. ;Now add the PREFERRED LANGUAGE field
  1. W !
  1. K DA,DIE,DR
  1. N DA,DIC,X,Y
  1. S DA(2)=FAC,DA(1)=FLIEN
  1. S DIC="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
  1. S DIC(0)="LS"
  1. S X=".04"
  1. D ^DIC
  1. S PRFIEN=+Y
  1. I +PRFIEN W " REQUIRED? parameter added for site: ",$$GET1^DIQ(9999999.06,FAC_",",.01,"E")
  1. ;
  1. ;Set the required value to NO
  1. K DA,DIC,X,Y
  1. N DA,DIE,DR
  1. S DA(2)=FAC,DA(1)=FLIEN,DA=PRFIEN
  1. S DIE="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
  1. S DR=".02////0"
  1. D ^DIE
  1. ;
  1. ;Now change the file back to 9000001
  1. K DA,DIE,DR
  1. N DA,DIE,DR
  1. S DA(1)=FAC,DA=FLIEN
  1. S DIE="^AGFAC("_DA(1)_",11,"
  1. S DR=".01////9000001"
  1. D ^DIE
  1. ;
  1. Q
  1. ;
  1. PRIM(FAC) ;Add PRIMARY LANGUAGE to facility required field list
  1. ;
  1. N PRFIEN,DA,DIC,FLIEN,X,Y
  1. ;
  1. ;First Look for existing 9000001 entry
  1. S DA(1)=FAC
  1. S DIC="^AGFAC("_FAC_",11,"
  1. S DIC(0)="L"
  1. S X="9000001"
  1. D ^DIC
  1. Q:Y'>0
  1. S FLIEN=+Y
  1. ;
  1. ;Quit if PRIMARY LANGUAGE already defined
  1. I $O(^AGFAC(FAC,11,FLIEN,1,"B","PRIMARY LANGUAGE",""))]"" Q
  1. ;
  1. ;Now change the file to 9000001.86 so it can pass input transform check
  1. K DA,DIC,X,Y
  1. N DA,DIE,DR
  1. S DA(1)=FAC,DA=FLIEN
  1. S DIE="^AGFAC("_DA(1)_",11,"
  1. S DR=".01////9000001.86"
  1. D ^DIE
  1. ;
  1. ;Now add the PRIMARY LANGUAGE field
  1. W !
  1. K DA,DIE,DR
  1. N DA,DIC,X,Y
  1. S DA(2)=FAC,DA(1)=FLIEN
  1. S DIC="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
  1. S DIC(0)="LS"
  1. S X=".02"
  1. D ^DIC
  1. S PRFIEN=+Y
  1. I +PRFIEN W " REQUIRED? parameter added for site: ",$$GET1^DIQ(9999999.06,FAC_",",.01,"E")
  1. ;
  1. ;Set the required value to NO
  1. K DA,DIC,X,Y
  1. N DA,DIE,DR
  1. S DA(2)=FAC,DA(1)=FLIEN,DA=PRFIEN
  1. S DIE="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
  1. S DR=".02////0"
  1. D ^DIE
  1. ;
  1. ;Now change the file back to 9000001
  1. K DA,DIE,DR
  1. N DA,DIE,DR
  1. S DA(1)=FAC,DA=FLIEN
  1. S DIE="^AGFAC("_DA(1)_",11,"
  1. S DR=".01////9000001"
  1. D ^DIE
  1. ;
  1. Q