AG71A9 ;VNGT/HS/BEE - Patient Registration 7.1 PATCH 9 POST INSTALL ; MAY 07, 2010
;;7.1;PATIENT REGISTRATION;**9**;AUG 25, 2005
;
Q
;
POST ;EP - From KIDS.
;
N CLBEN,MMSG,IEN,AMIND
D TS,BMES^XPDUTL("Beginning post-install routine (POST^AG71A9).")
;
S MMSG=" --- AG v 7.1 Patch 9 has been installed into this uci --- "
;
;Set new 'LINK AOB TO ROI FIELD' to default of 'NO'
;and define new facility parameter ROI/AOB required prompts
W !
S IEN=0 F S IEN=$O(^AGFAC(IEN)) Q:'IEN D
. ;
. ;Set up new ETHNICITY INFORMATION Required registration parameter prompt
. D ETHN^AG71A9(IEN)
. ;
. ;Set up new RACE Required registration parameter prompt
. D RACE^AG71A9(IEN)
. ;
. ;Set up new PREFERRED LANGUAGE Required registration parameter prompt
. D PREF^AG71A9(IEN)
. ;
. ;Set up new PRIMARY LANGUAGE Required registration parameter prompt
. D PRIM^AG71A9(IEN)
. ;
. ;Set up Homeless and Migrant prompts with default of no
. D HOM^AG71A9(IEN)
;
;Remove the lock from the AGSETSITE option
N DIC,X,Y S DIC="^DIC(19,",X="AGSETSITE"
D ^DIC
I +Y>0 D
. N DA,DIC,DIE,DR,X
. S DA=+Y
. S DIE="^DIC(19,"
. S DR="3////@"
. D ^DIE
K DIC,X,Y
;
;Populate Race field based on CLASSIFICATION/BENEFICIARY
D TS,BMES^XPDUTL("AutoPopulating PATIENT RACE field (POST^AG71A9).")
S CLBEN=$O(^AUTTBEN("B","INDIAN/ALASKA NATIVE","")) ;Get Classification IEN
S AMIND=$O(^DIC(10,"B","AMERICAN INDIAN OR ALASKA NATIVE","")) ;Get Amer/Ind IEN
;
I CLBEN]"",AMIND]"" D
. N DFN,X,ERROR
. S DFN=0 F S DFN=$O(^DPT(DFN)) Q:'DFN D
.. ;
.. ;Quit if CLASSIFICATION/BENEFICIARY not equal to INDIAN/ALASKA NATIVE
.. Q:$$GET1^DIQ(9000001,DFN_",",1111,"I")'=CLBEN
.. ;
.. ;Update RACE
.. K DA,DIC,X,Y
.. N DA,DIE,DR
.. S DA=DFN
.. S DIE="^DPT("
.. S DR=".06////"_AMIND
.. D ^DIE
;
D TS,BMES^XPDUTL("Delivering v 7.1 Patch 9 install message to select users...")
;
;Deliver Mail Message
D MAIL(MMSG)
;
D TS,BMES^XPDUTL("AG v 7.1 Patch 9 Post-install is complete.")
Q
;
MAIL(MMSG) ;Send install mail message.
N %,CNT,DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
K ^TMP("AG71MS",$J)
S ^TMP("AG71MS",$J,1)=$G(MMSG)
S ^TMP("AG71MS",$J,2)=" "
S CNT=3
;
S %=0
Q:$G(XPDA)=""
Q:$G(XPDBLD)=""
F S %=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%)) Q:'% S ^TMP("AG71MS",$J,(%+CNT))=" "_^(%,0)
S XMSUB=$P($P($T(+1),";",2)," ",3,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""AG71MS"",$J,",XMY(1)="",XMY(DUZ)=""
F %="AGZMENU","XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
D ^XMD
K ^TMP("AG71MS",$J)
Q
SINGLE(K) ;EP - Get holders of a single key K.
N Y
S Y=0
Q:'$D(^XUSEC(K))
F S Y=$O(^XUSEC(K,Y)) Q:'Y S XMY(Y)=""
Q
;
TS D MES^XPDUTL($$HTE^XLFDT($H)) Q
;
HOM(FAC) ;Set Homeless and Migrant Display parameters
;
N VAL
;
;Homeless Display
S VAL=$$GET1^DIQ(9009061,FAC_",",28) I VAL="" D
. ;
. ;Set the display to "YES"
. K DA,DIC,X,Y
. N DA,DIE,DR
. S DA=FAC
. S DIE="^AGFAC("
. S DR="28////Y"
. D ^DIE
;
;Migrant Display
S VAL=$$GET1^DIQ(9009061,FAC_",",27) I VAL="" D
. ;
. ;Set the display to "YES"
. K DA,DIC,X,Y
. N DA,DIE,DR
. S DA=FAC
. S DIE="^AGFAC("
. S DR="27////Y"
. D ^DIE
;
Q
;
ETHN(FAC) ;Now add the ETHNICITY field
;
N PRFIEN,DA,DIC,FLIEN,X,Y
;
;First Look for existing 2 entry
S DA(1)=FAC
S DIC="^AGFAC("_FAC_",11,"
S DIC(0)="L"
S X="2"
D ^DIC
Q:Y'>0
S FLIEN=+Y
;
;Quit if ETHNICITY INFORMATION already defined
I $O(^AGFAC(FAC,11,FLIEN,1,"B","ETHNICITY INFORMATION",""))]"" Q
;
;Now add the ETHNICITY field
W !
K DA,DIE,DR
N DA,DIC,X,Y
S DA(2)=FAC,DA(1)=FLIEN
S DIC="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
S DIC(0)="LS"
S X="6"
D ^DIC
S PRFIEN=+Y
I +PRFIEN W " REQUIRED? parameter added for site: ",$$GET1^DIQ(9999999.06,FAC_",",.01,"E")
;
;Set the required value to NO
K DA,DIC,X,Y
N DA,DIE,DR
S DA(2)=FAC,DA(1)=FLIEN,DA=PRFIEN
S DIE="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
S DR=".02////0"
D ^DIE
Q
;
RACE(FAC) ;Now add the RACE field
;
N PRFIEN,DA,DIC,FLIEN,X,Y
;
;First Look for existing 2 entry
S DA(1)=FAC
S DIC="^AGFAC("_FAC_",11,"
S DIC(0)="L"
S X="2"
D ^DIC
Q:Y'>0
S FLIEN=+Y
;
;Quit if RACE already defined
I $O(^AGFAC(FAC,11,FLIEN,1,"B","RACE",""))]"" Q
;
;Now add the RACE field
W !
K DA,DIE,DR
N DA,DIC,X,Y
S DA(2)=FAC,DA(1)=FLIEN
S DIC="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
S DIC(0)="LS"
S X=".06"
D ^DIC
S PRFIEN=+Y
I +PRFIEN W " REQUIRED? parameter added for site: ",$$GET1^DIQ(9999999.06,FAC_",",.01,"E")
;
;Set the required value to NO
K DA,DIC,X,Y
N DA,DIE,DR
S DA(2)=FAC,DA(1)=FLIEN,DA=PRFIEN
S DIE="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
S DR=".02////0"
D ^DIE
;
Q
;
PREF(FAC) ;Add PREFERRED LANGUAGE to facility required field list
;
N PRFIEN,DA,DIC,FLIEN,X,Y
;
;First Look for existing 9000001 entry
S DA(1)=FAC
S DIC="^AGFAC("_FAC_",11,"
S DIC(0)="L"
S X="9000001"
D ^DIC
Q:Y'>0
S FLIEN=+Y
;
;Quit if PREFERRED LANGUAGE already defined
I $O(^AGFAC(FAC,11,FLIEN,1,"B","PREFERRED LANGUAGE",""))]"" Q
;
;Now change the file to 9000001.86 so it can pass input transform check
K DA,DIC,X,Y
N DA,DIE,DR
S DA(1)=FAC,DA=FLIEN
S DIE="^AGFAC("_DA(1)_",11,"
S DR=".01////9000001.86"
D ^DIE
;
;Now add the PREFERRED LANGUAGE field
W !
K DA,DIE,DR
N DA,DIC,X,Y
S DA(2)=FAC,DA(1)=FLIEN
S DIC="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
S DIC(0)="LS"
S X=".04"
D ^DIC
S PRFIEN=+Y
I +PRFIEN W " REQUIRED? parameter added for site: ",$$GET1^DIQ(9999999.06,FAC_",",.01,"E")
;
;Set the required value to NO
K DA,DIC,X,Y
N DA,DIE,DR
S DA(2)=FAC,DA(1)=FLIEN,DA=PRFIEN
S DIE="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
S DR=".02////0"
D ^DIE
;
;Now change the file back to 9000001
K DA,DIE,DR
N DA,DIE,DR
S DA(1)=FAC,DA=FLIEN
S DIE="^AGFAC("_DA(1)_",11,"
S DR=".01////9000001"
D ^DIE
;
Q
;
PRIM(FAC) ;Add PRIMARY LANGUAGE to facility required field list
;
N PRFIEN,DA,DIC,FLIEN,X,Y
;
;First Look for existing 9000001 entry
S DA(1)=FAC
S DIC="^AGFAC("_FAC_",11,"
S DIC(0)="L"
S X="9000001"
D ^DIC
Q:Y'>0
S FLIEN=+Y
;
;Quit if PRIMARY LANGUAGE already defined
I $O(^AGFAC(FAC,11,FLIEN,1,"B","PRIMARY LANGUAGE",""))]"" Q
;
;Now change the file to 9000001.86 so it can pass input transform check
K DA,DIC,X,Y
N DA,DIE,DR
S DA(1)=FAC,DA=FLIEN
S DIE="^AGFAC("_DA(1)_",11,"
S DR=".01////9000001.86"
D ^DIE
;
;Now add the PRIMARY LANGUAGE field
W !
K DA,DIE,DR
N DA,DIC,X,Y
S DA(2)=FAC,DA(1)=FLIEN
S DIC="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
S DIC(0)="LS"
S X=".02"
D ^DIC
S PRFIEN=+Y
I +PRFIEN W " REQUIRED? parameter added for site: ",$$GET1^DIQ(9999999.06,FAC_",",.01,"E")
;
;Set the required value to NO
K DA,DIC,X,Y
N DA,DIE,DR
S DA(2)=FAC,DA(1)=FLIEN,DA=PRFIEN
S DIE="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
S DR=".02////0"
D ^DIE
;
;Now change the file back to 9000001
K DA,DIE,DR
N DA,DIE,DR
S DA(1)=FAC,DA=FLIEN
S DIE="^AGFAC("_DA(1)_",11,"
S DR=".01////9000001"
D ^DIE
;
Q
AG71A9 ;VNGT/HS/BEE - Patient Registration 7.1 PATCH 9 POST INSTALL ; MAY 07, 2010
+1 ;;7.1;PATIENT REGISTRATION;**9**;AUG 25, 2005
+2 ;
+3 QUIT
+4 ;
POST ;EP - From KIDS.
+1 ;
+2 NEW CLBEN,MMSG,IEN,AMIND
+3 DO TS
DO BMES^XPDUTL("Beginning post-install routine (POST^AG71A9).")
+4 ;
+5 SET MMSG=" --- AG v 7.1 Patch 9 has been installed into this uci --- "
+6 ;
+7 ;Set new 'LINK AOB TO ROI FIELD' to default of 'NO'
+8 ;and define new facility parameter ROI/AOB required prompts
+9 WRITE !
+10 SET IEN=0
FOR
SET IEN=$ORDER(^AGFAC(IEN))
IF 'IEN
QUIT
Begin DoDot:1
+11 ;
+12 ;Set up new ETHNICITY INFORMATION Required registration parameter prompt
+13 DO ETHN^AG71A9(IEN)
+14 ;
+15 ;Set up new RACE Required registration parameter prompt
+16 DO RACE^AG71A9(IEN)
+17 ;
+18 ;Set up new PREFERRED LANGUAGE Required registration parameter prompt
+19 DO PREF^AG71A9(IEN)
+20 ;
+21 ;Set up new PRIMARY LANGUAGE Required registration parameter prompt
+22 DO PRIM^AG71A9(IEN)
+23 ;
+24 ;Set up Homeless and Migrant prompts with default of no
+25 DO HOM^AG71A9(IEN)
End DoDot:1
+26 ;
+27 ;Remove the lock from the AGSETSITE option
+28 NEW DIC,X,Y
SET DIC="^DIC(19,"
SET X="AGSETSITE"
+29 DO ^DIC
+30 IF +Y>0
Begin DoDot:1
+31 NEW DA,DIC,DIE,DR,X
+32 SET DA=+Y
+33 SET DIE="^DIC(19,"
+34 SET DR="3////@"
+35 DO ^DIE
End DoDot:1
+36 KILL DIC,X,Y
+37 ;
+38 ;Populate Race field based on CLASSIFICATION/BENEFICIARY
+39 DO TS
DO BMES^XPDUTL("AutoPopulating PATIENT RACE field (POST^AG71A9).")
+40 ;Get Classification IEN
SET CLBEN=$ORDER(^AUTTBEN("B","INDIAN/ALASKA NATIVE",""))
+41 ;Get Amer/Ind IEN
SET AMIND=$ORDER(^DIC(10,"B","AMERICAN INDIAN OR ALASKA NATIVE",""))
+42 ;
+43 IF CLBEN]""
IF AMIND]""
Begin DoDot:1
+44 NEW DFN,X,ERROR
+45 SET DFN=0
FOR
SET DFN=$ORDER(^DPT(DFN))
IF 'DFN
QUIT
Begin DoDot:2
+46 ;
+47 ;Quit if CLASSIFICATION/BENEFICIARY not equal to INDIAN/ALASKA NATIVE
+48 IF $$GET1^DIQ(9000001,DFN_",",1111,"I")'=CLBEN
QUIT
+49 ;
+50 ;Update RACE
+51 KILL DA,DIC,X,Y
+52 NEW DA,DIE,DR
+53 SET DA=DFN
+54 SET DIE="^DPT("
+55 SET DR=".06////"_AMIND
+56 DO ^DIE
End DoDot:2
End DoDot:1
+57 ;
+58 DO TS
DO BMES^XPDUTL("Delivering v 7.1 Patch 9 install message to select users...")
+59 ;
+60 ;Deliver Mail Message
+61 DO MAIL(MMSG)
+62 ;
+63 DO TS
DO BMES^XPDUTL("AG v 7.1 Patch 9 Post-install is complete.")
+64 QUIT
+65 ;
MAIL(MMSG) ;Send install mail message.
+1 NEW %,CNT,DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
+2 KILL ^TMP("AG71MS",$JOB)
+3 SET ^TMP("AG71MS",$JOB,1)=$GET(MMSG)
+4 SET ^TMP("AG71MS",$JOB,2)=" "
+5 SET CNT=3
+6 ;
+7 SET %=0
+8 IF $GET(XPDA)=""
QUIT
+9 IF $GET(XPDBLD)=""
QUIT
+10 FOR
SET %=$ORDER(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%))
IF '%
QUIT
SET ^TMP("AG71MS",$JOB,(%+CNT))=" "_^(%,0)
+11 SET XMSUB=$PIECE($PIECE($TEXT(+1),";",2)," ",3,99)
SET XMDUZ=$SELECT($GET(DUZ):DUZ,1:.5)
SET XMTEXT="^TMP(""AG71MS"",$J,"
SET XMY(1)=""
SET XMY(DUZ)=""
+12 FOR %="AGZMENU","XUMGR","XUPROG","XUPROGMODE"
DO SINGLE(%)
+13 DO ^XMD
+14 KILL ^TMP("AG71MS",$JOB)
+15 QUIT
SINGLE(K) ;EP - Get holders of a single key K.
+1 NEW Y
+2 SET Y=0
+3 IF '$DATA(^XUSEC(K))
QUIT
+4 FOR
SET Y=$ORDER(^XUSEC(K,Y))
IF 'Y
QUIT
SET XMY(Y)=""
+5 QUIT
+6 ;
TS DO MES^XPDUTL($$HTE^XLFDT($HOROLOG))
QUIT
+1 ;
HOM(FAC) ;Set Homeless and Migrant Display parameters
+1 ;
+2 NEW VAL
+3 ;
+4 ;Homeless Display
+5 SET VAL=$$GET1^DIQ(9009061,FAC_",",28)
IF VAL=""
Begin DoDot:1
+6 ;
+7 ;Set the display to "YES"
+8 KILL DA,DIC,X,Y
+9 NEW DA,DIE,DR
+10 SET DA=FAC
+11 SET DIE="^AGFAC("
+12 SET DR="28////Y"
+13 DO ^DIE
End DoDot:1
+14 ;
+15 ;Migrant Display
+16 SET VAL=$$GET1^DIQ(9009061,FAC_",",27)
IF VAL=""
Begin DoDot:1
+17 ;
+18 ;Set the display to "YES"
+19 KILL DA,DIC,X,Y
+20 NEW DA,DIE,DR
+21 SET DA=FAC
+22 SET DIE="^AGFAC("
+23 SET DR="27////Y"
+24 DO ^DIE
End DoDot:1
+25 ;
+26 QUIT
+27 ;
ETHN(FAC) ;Now add the ETHNICITY field
+1 ;
+2 NEW PRFIEN,DA,DIC,FLIEN,X,Y
+3 ;
+4 ;First Look for existing 2 entry
+5 SET DA(1)=FAC
+6 SET DIC="^AGFAC("_FAC_",11,"
+7 SET DIC(0)="L"
+8 SET X="2"
+9 DO ^DIC
+10 IF Y'>0
QUIT
+11 SET FLIEN=+Y
+12 ;
+13 ;Quit if ETHNICITY INFORMATION already defined
+14 IF $ORDER(^AGFAC(FAC,11,FLIEN,1,"B","ETHNICITY INFORMATION",""))]""
QUIT
+15 ;
+16 ;Now add the ETHNICITY field
+17 WRITE !
+18 KILL DA,DIE,DR
+19 NEW DA,DIC,X,Y
+20 SET DA(2)=FAC
SET DA(1)=FLIEN
+21 SET DIC="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
+22 SET DIC(0)="LS"
+23 SET X="6"
+24 DO ^DIC
+25 SET PRFIEN=+Y
+26 IF +PRFIEN
WRITE " REQUIRED? parameter added for site: ",$$GET1^DIQ(9999999.06,FAC_",",.01,"E")
+27 ;
+28 ;Set the required value to NO
+29 KILL DA,DIC,X,Y
+30 NEW DA,DIE,DR
+31 SET DA(2)=FAC
SET DA(1)=FLIEN
SET DA=PRFIEN
+32 SET DIE="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
+33 SET DR=".02////0"
+34 DO ^DIE
+35 QUIT
+36 ;
RACE(FAC) ;Now add the RACE field
+1 ;
+2 NEW PRFIEN,DA,DIC,FLIEN,X,Y
+3 ;
+4 ;First Look for existing 2 entry
+5 SET DA(1)=FAC
+6 SET DIC="^AGFAC("_FAC_",11,"
+7 SET DIC(0)="L"
+8 SET X="2"
+9 DO ^DIC
+10 IF Y'>0
QUIT
+11 SET FLIEN=+Y
+12 ;
+13 ;Quit if RACE already defined
+14 IF $ORDER(^AGFAC(FAC,11,FLIEN,1,"B","RACE",""))]""
QUIT
+15 ;
+16 ;Now add the RACE field
+17 WRITE !
+18 KILL DA,DIE,DR
+19 NEW DA,DIC,X,Y
+20 SET DA(2)=FAC
SET DA(1)=FLIEN
+21 SET DIC="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
+22 SET DIC(0)="LS"
+23 SET X=".06"
+24 DO ^DIC
+25 SET PRFIEN=+Y
+26 IF +PRFIEN
WRITE " REQUIRED? parameter added for site: ",$$GET1^DIQ(9999999.06,FAC_",",.01,"E")
+27 ;
+28 ;Set the required value to NO
+29 KILL DA,DIC,X,Y
+30 NEW DA,DIE,DR
+31 SET DA(2)=FAC
SET DA(1)=FLIEN
SET DA=PRFIEN
+32 SET DIE="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
+33 SET DR=".02////0"
+34 DO ^DIE
+35 ;
+36 QUIT
+37 ;
PREF(FAC) ;Add PREFERRED LANGUAGE to facility required field list
+1 ;
+2 NEW PRFIEN,DA,DIC,FLIEN,X,Y
+3 ;
+4 ;First Look for existing 9000001 entry
+5 SET DA(1)=FAC
+6 SET DIC="^AGFAC("_FAC_",11,"
+7 SET DIC(0)="L"
+8 SET X="9000001"
+9 DO ^DIC
+10 IF Y'>0
QUIT
+11 SET FLIEN=+Y
+12 ;
+13 ;Quit if PREFERRED LANGUAGE already defined
+14 IF $ORDER(^AGFAC(FAC,11,FLIEN,1,"B","PREFERRED LANGUAGE",""))]""
QUIT
+15 ;
+16 ;Now change the file to 9000001.86 so it can pass input transform check
+17 KILL DA,DIC,X,Y
+18 NEW DA,DIE,DR
+19 SET DA(1)=FAC
SET DA=FLIEN
+20 SET DIE="^AGFAC("_DA(1)_",11,"
+21 SET DR=".01////9000001.86"
+22 DO ^DIE
+23 ;
+24 ;Now add the PREFERRED LANGUAGE field
+25 WRITE !
+26 KILL DA,DIE,DR
+27 NEW DA,DIC,X,Y
+28 SET DA(2)=FAC
SET DA(1)=FLIEN
+29 SET DIC="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
+30 SET DIC(0)="LS"
+31 SET X=".04"
+32 DO ^DIC
+33 SET PRFIEN=+Y
+34 IF +PRFIEN
WRITE " REQUIRED? parameter added for site: ",$$GET1^DIQ(9999999.06,FAC_",",.01,"E")
+35 ;
+36 ;Set the required value to NO
+37 KILL DA,DIC,X,Y
+38 NEW DA,DIE,DR
+39 SET DA(2)=FAC
SET DA(1)=FLIEN
SET DA=PRFIEN
+40 SET DIE="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
+41 SET DR=".02////0"
+42 DO ^DIE
+43 ;
+44 ;Now change the file back to 9000001
+45 KILL DA,DIE,DR
+46 NEW DA,DIE,DR
+47 SET DA(1)=FAC
SET DA=FLIEN
+48 SET DIE="^AGFAC("_DA(1)_",11,"
+49 SET DR=".01////9000001"
+50 DO ^DIE
+51 ;
+52 QUIT
+53 ;
PRIM(FAC) ;Add PRIMARY LANGUAGE to facility required field list
+1 ;
+2 NEW PRFIEN,DA,DIC,FLIEN,X,Y
+3 ;
+4 ;First Look for existing 9000001 entry
+5 SET DA(1)=FAC
+6 SET DIC="^AGFAC("_FAC_",11,"
+7 SET DIC(0)="L"
+8 SET X="9000001"
+9 DO ^DIC
+10 IF Y'>0
QUIT
+11 SET FLIEN=+Y
+12 ;
+13 ;Quit if PRIMARY LANGUAGE already defined
+14 IF $ORDER(^AGFAC(FAC,11,FLIEN,1,"B","PRIMARY LANGUAGE",""))]""
QUIT
+15 ;
+16 ;Now change the file to 9000001.86 so it can pass input transform check
+17 KILL DA,DIC,X,Y
+18 NEW DA,DIE,DR
+19 SET DA(1)=FAC
SET DA=FLIEN
+20 SET DIE="^AGFAC("_DA(1)_",11,"
+21 SET DR=".01////9000001.86"
+22 DO ^DIE
+23 ;
+24 ;Now add the PRIMARY LANGUAGE field
+25 WRITE !
+26 KILL DA,DIE,DR
+27 NEW DA,DIC,X,Y
+28 SET DA(2)=FAC
SET DA(1)=FLIEN
+29 SET DIC="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
+30 SET DIC(0)="LS"
+31 SET X=".02"
+32 DO ^DIC
+33 SET PRFIEN=+Y
+34 IF +PRFIEN
WRITE " REQUIRED? parameter added for site: ",$$GET1^DIQ(9999999.06,FAC_",",.01,"E")
+35 ;
+36 ;Set the required value to NO
+37 KILL DA,DIC,X,Y
+38 NEW DA,DIE,DR
+39 SET DA(2)=FAC
SET DA(1)=FLIEN
SET DA=PRFIEN
+40 SET DIE="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
+41 SET DR=".02////0"
+42 DO ^DIE
+43 ;
+44 ;Now change the file back to 9000001
+45 KILL DA,DIE,DR
+46 NEW DA,DIE,DR
+47 SET DA(1)=FAC
SET DA=FLIEN
+48 SET DIE="^AGFAC("_DA(1)_",11,"
+49 SET DR=".01////9000001"
+50 DO ^DIE
+51 ;
+52 QUIT
