AG6P17A ;IHS/ASDST/GTH - Patient Registration 6.0 Patch 17 CONT. ; [ 04/08/2003 8:49 AM ]
;;7.0;IHS PATIENT REGISTRATION;;MAR 28, 2003
;
; IHS/SET/GTH AG*6*17 10/11/2002
;
PRE ;EP - From KIDS.
Q
;
POST ;EP - From KIDS.
;
D BMES^XPDUTL("Beginning post-install routine (POST^AG6P17)."),TS
;
I '$$INSTALLD^AG6P17("AG*6.0*14") D TS,IP14
;
I '$$INSTALLD^AG6P17("AG*6.0*15") D TS,IP15
;
I $$INSTALLD^AG6P17("AG*6.0*17") D
. D ^AGSETPRT
. D TS,BMES^XPDUTL("Delivering AG*7.0 install message to select users...")
. D MAIL
. D BMES^XPDUTL("Post-install routine is complete."),TS
;
Q:$$INSTALLD^AG6P17("AG*6.0*17")
;
D TS,OPTRES("AGMENU")
;
D TS,UPLG
;
D TS,CMS
;
D TS,P17^AG6P17B
;
D TS,INDXC^AG6P17B
;
D TS,COVIT^AG6P17B
;
D TS,AGTX^AG6P17B
;
D TS,DELR^AG6P17B
;
D TS,EV^AG6P17B
;
D TS,BMES^XPDUTL("Delivering AG*7.0 install message to select users...")
D MAIL
;
D DELOPT
;
D ^AGSETPRT
;
D BMES^XPDUTL("Post-install routine is complete."),TS
Q
;
MAIL ; Send install mail message.
NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
KILL ^TMP("AG6P17MS",$J)
S ^TMP("AG6P17MS",$J,1)=" --- AG v 7.0, has been installed into this uci ---"
S %=0
F S %=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%)) Q:'% S ^TMP("AG6P17MS",$J,(%+1))=" "_^(%,0)
S XMSUB=$P($P($T(+1),";",2)," ",3,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""AG6P17MS"",$J,",XMY(1)="",XMY(DUZ)=""
F %="AGZMENU","XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
D ^XMD
KILL ^TMP("AG6P17MS",$J)
Q
;
DELOPT ; Delete OPTION "AG DDPS HRN DEL"
S RECNO=0
F S RECNO=$O(^DIC(19,"B","AG DDPS HRN DEL",RECNO)) Q:'RECNO D
. S DIK="^DIC(19,",DA=RECNO D ^DIK
Q
;
SINGLE(K) ;EP - Get holders of a single key K.
NEW Y
S Y=0
Q:'$D(^XUSEC(K))
F S Y=$O(^XUSEC(K,Y)) Q:'Y S XMY(Y)=""
Q
;
;
INDEXAI ; REINDEX AI XREF PREVIOUS COMMUNITY
;
; Thanks to Toni Jarland for the original routine. Aug 17 2001.
;
;This runs the AI X-Ref Re-Index of the Previous Communty Multiple
;$Order through each AUPNPAT Global Entry & Re-Index AI X-Ref
;The AI X-Ref calls Routine AUPNPCTR which $O thru the Previous
;Community Multiple & resets the Last Previous Community Entry
;to fields #1117 Current Community Mulitple & #1118 Current Community
;Text Value. This will clean up missing Community Pointers used
;in the Patient Registration Re-export
;
I $P($T(+2^AUPNPCTR),";",5)'="**6**" D Q
. D BMES^XPDUTL("AUPN PATCH 6 IS NOT INSTALLED.")
. D BMES^XPDUTL("THE AI X-REF RE-FIRE WILL BE IN VAIN.")
. D BMES^XPDUTL("INSTALL AUPN 99.1 PATCH 6 AND RUN INDEXAI^AG6P17.")
.Q
NEW AGB,AGE
S AGB=$$NOW^XLFDT
D BMES^XPDUTL("Begin Re-Indexing AI Cross Reference of PATIENT File, "_$$FMTE^XLFDT(AGB))
W:'$D(ZTQUEUED) !,"Estimated % complete:",!
NEW AGP3,DA,DIK
S DA(1)=0,DIK(1)=".03^AI",AGP3=$P(^AUPNPAT(0),U,3)
F S DA(1)=$O(^AUPNPAT(DA(1))) Q:'DA(1) D
. S DIK="^AUPNPAT("_DA(1)_",51,"
. D ENALL^DIK
. I '(DA(1)#100),'$D(ZTQUEUED) W " | ",$J(DA(1)/AGP3*100,0,0),"%"
.Q
;
S AGE=$$NOW^XLFDT
D BMES^XPDUTL("End of Re-Indexing AI Cross Reference of PATIENT File, "_$$FMTE^XLFDT(AGE))
D BMES^XPDUTL($$FMDIFF^XLFDT(AGE,AGB,2)_" seconds")
Q
;
OPTRES(AGM) ;
D BMES^XPDUTL("Restoring '"_AGM_"' option to PRE-install configuration...")
NEW AG,AGI
I '$D(^XTMP("AG6P17",6.17,"OPTSAV",AGM)) D BMES^XPDUTL("FAILED. Option '"_AGM_"' was not previously saved.") Q
S AG=0
F S AG=$O(^XTMP("AG6P17",6.17,"OPTSAV",AGM,AG)) Q:'AG S AGI=^(AG) I '$$ADD^XPDMENU(AGM,$P(AGI,U,1),$P(AGI,U,2),$P(AGI,U,3)) D BMES^XPDUTL("....FAILED to re-atch "_$P(AGI,U,1)_" to "_AGM_".")
Q
;
IP14 ; Items from patch 14.
D BMES^XPDUTL("Patch 14 was not installed. Performing P14 items...")
;
D INDEXAI
;
D BMES^XPDUTL("Q'ing Name check report...")
S ZTRTN="START^AGEDNAME",ZTIO="",ZTDESC=$P($P($T(+1^AGEDNAME),";",2)," ",3,99),ZTDTH=$H
D ^%ZTLOAD
I $D(ZTSK) D MES^XPDUTL("Que'd to task "_ZTSK_".") I 1
E D BMES^XPDUTL("Que of Name check report *FAILED*.")
;
D BMES^XPDUTL("Attaching ""AG REP NAME CHECK"" option to menu ""REGISTRATION REPORTS"".")
I $$ADD^XPDMENU("AGREPORTS","AG REP NAME CHECK","STD",25) D BMES^XPDUTL("....successfully atch'd....allocating Security Keys...") D I 1
. NEW AG,DA,DIC,DINUM
. S AG=0,AG("RPT")=$O(^DIC(19.1,"B","AGZREPORTS",0)),AG("STD")=$O(^DIC(19.1,"B","AGZNAMECHECK",0))
. Q:'AG("RPT")!'AG("STD")
. S DIC(0)="NMQ",DIC("P")="200.051PA"
. F S AG=$O(^XUSEC("AGZREPORTS",AG)) Q:'AG D
.. Q:$D(^VA(200,AG,51,AG("STD")))
.. S DIC="^VA(200,AG,51,",DA(1)=AG,(DINUM,X)=AG("STD")
.. D FILE^DICN
..Q
.Q
E D BMES^XPDUTL("....Attachment *FAILED*.")
;
D BMES^XPDUTL("Attaching ""AGTXALL"" option to the export menu ""AGTX"".")
I $$ADD^XPDMENU("AGTX","AGTXALL","ALL",10) D BMES^XPDUTL("....successfully atch'd."),BMES^XPDUTL("NOTE: Security key will *NOT* be allocated.") I 1
E D BMES^XPDUTL("....Attachment *FAILED*.")
;
Q
;
IP15 ;
D BMES^XPDUTL("Patch 15 was not installed. Performing P15 items...")
;
D BMES^XPDUTL("Attaching ""AG TM ELIGIBILITY"" option to the table maintenance menu ""TM"".")
I $$ADD^XPDMENU("AG TM MENU","AG TM ELIGIBILITY","ELUP",10) D BMES^XPDUTL("....successfully atch'd.") I 1
E D BMES^XPDUTL("....Attachment *FAILED*.")
;
D BMES^XPDUTL("Attaching ""AG3PSUM"" option to the the Third Party Billing Reports ""THR"".")
I $$ADD^XPDMENU("AGBILL","AG3PSUM","AGSM",4) D BMES^XPDUTL("....successfully atch'd.") I 1
E D BMES^XPDUTL("....Attachment *FAILED*.")
;
I $$VAL^XBDIQ1(9999999.39,1,.15)'="YES" D
. NEW AG
. S AG=0
. F S AG=$O(^ABMDCLM(AG)) Q:'AG I $$FMDIFF^XLFDT(DT,$O(^ABMDCLM(AG,"AC",9999999),-1),1)<180 D Q
.. NEW DA,DIE,DR
.. S DIE=9999999.39,DA=1,DR=".15///Y"
.. D ^DIE
.. I '$D(Y) D Q
... D BMES^XPDUTL("The 'THIRD-PARTY BILLING PRESENT' field in RPMS SITE had been changed to 'YES',")
... D MES^XPDUTL("based on 3PB editing activity in the last 6 months."),MES^XPDUTL("'YES' ensures setting of the 'ABILL' x-ref in the VISIT file.")
...Q
.. D BMES^XPDUTL("** ERROR: EDIT OF .15 IN RPMS SITE FILE FAILED.")
.. Q
.Q
Q
;
UPLG ; Fix bug in ^AGELUPLG.
D BMES^XPDUTL("Fixing bad info in ELIGIBILITY UPLOAD LOG caused by bug...")
NEW AGDA,AGRUN,AGSUB,DA,DFN,DIK
S AGRUN=0
F S AGRUN=$O(^AGELUPLG(AGRUN)) Q:'AGRUN D
. F AGSUB=1,2 S AGDA=0 F S AGDA=$O(^AGELUPLG(AGRUN,AGSUB,AGDA)) W:'$D(ZTQUEUED) "." Q:'AGDA S DFN=$P(^(AGDA,0),U) I AGDA'=DFN D
.. S DIK="^AGELUPLG("_AGRUN_","_AGSUB_",",DA(1)=AGRUN,DA=AGDA
.. D ^DIK
.. D PTACT^AGELUP2(AGSUB,DFN)
.Q
D MES^XPDUTL("Fix complete.")
Q
;
CMS ; Deactive the CMS Railroad template and re-name both from "HCFA" to "CMS".
D BMES^XPDUTL("Deactivating HCFA Railroad template, renaming both templates....")
NEW AGY,DIC,X
S DIC=9009062.01,DIC(0)="",X="HCFA RAILROAD RETIREMENT"
D ^DIC
I +Y<1 D MES^XPDUTL("'HCFA RAILROAD RETIREMENT' template not found (that's OK).") I 1
E D
. NEW DA,DIE,DR
. S AGY=$P(Y,U,2),DA=+Y,DIE=DIC,DR=".01///CMS RAILROAD RETIREMENT;.07///"_DT
. D ^DIE
. D MES^XPDUTL("'"_AGY_"' template renamed 'CMS RAILROAD RETIREMENT'.")
.Q
S DIC=9009062.01,DIC(0)="",X="HCFA MEDICARE"
D ^DIC
I +Y<1 D MES^XPDUTL("'HCFA MEDICARE' template not found (that's OK).") I 1
E D
. NEW DA,DIE,DR
. S AGY=$P(Y,U,2),DA=+Y,DIE=DIC,DR=".01///CMS MEDICARE"
. D ^DIE
. D MES^XPDUTL("'"_AGY_"' template renamed 'CMS MEDICARE'.")
.Q
D MES^XPDUTL("CMS complete.")
Q
;
TS D MES^XPDUTL($$HTE^XLFDT($H)) Q
;
AG6P17A ;IHS/ASDST/GTH - Patient Registration 6.0 Patch 17 CONT. ; [ 04/08/2003 8:49 AM ]
+1 ;;7.0;IHS PATIENT REGISTRATION;;MAR 28, 2003
+2 ;
+3 ; IHS/SET/GTH AG*6*17 10/11/2002
+4 ;
PRE ;EP - From KIDS.
+1 QUIT
+2 ;
POST ;EP - From KIDS.
+1 ;
+2 DO BMES^XPDUTL("Beginning post-install routine (POST^AG6P17).")
DO TS
+3 ;
+4 IF '$$INSTALLD^AG6P17("AG*6.0*14")
DO TS
DO IP14
+5 ;
+6 IF '$$INSTALLD^AG6P17("AG*6.0*15")
DO TS
DO IP15
+7 ;
+8 IF $$INSTALLD^AG6P17("AG*6.0*17")
Begin DoDot:1
+9 DO ^AGSETPRT
+10 DO TS
DO BMES^XPDUTL("Delivering AG*7.0 install message to select users...")
+11 DO MAIL
+12 DO BMES^XPDUTL("Post-install routine is complete.")
DO TS
End DoDot:1
+13 ;
+14 IF $$INSTALLD^AG6P17("AG*6.0*17")
QUIT
+15 ;
+16 DO TS
DO OPTRES("AGMENU")
+17 ;
+18 DO TS
DO UPLG
+19 ;
+20 DO TS
DO CMS
+21 ;
+22 DO TS
DO P17^AG6P17B
+23 ;
+24 DO TS
DO INDXC^AG6P17B
+25 ;
+26 DO TS
DO COVIT^AG6P17B
+27 ;
+28 DO TS
DO AGTX^AG6P17B
+29 ;
+30 DO TS
DO DELR^AG6P17B
+31 ;
+32 DO TS
DO EV^AG6P17B
+33 ;
+34 DO TS
DO BMES^XPDUTL("Delivering AG*7.0 install message to select users...")
+35 DO MAIL
+36 ;
+37 DO DELOPT
+38 ;
+39 DO ^AGSETPRT
+40 ;
+41 DO BMES^XPDUTL("Post-install routine is complete.")
DO TS
+42 QUIT
+43 ;
MAIL ; Send install mail message.
+1 NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
+2 KILL ^TMP("AG6P17MS",$JOB)
+3 SET ^TMP("AG6P17MS",$JOB,1)=" --- AG v 7.0, has been installed into this uci ---"
+4 SET %=0
+5 FOR
SET %=$ORDER(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%))
IF '%
QUIT
SET ^TMP("AG6P17MS",$JOB,(%+1))=" "_^(%,0)
+6 SET XMSUB=$PIECE($PIECE($TEXT(+1),";",2)," ",3,99)
SET XMDUZ=$SELECT($GET(DUZ):DUZ,1:.5)
SET XMTEXT="^TMP(""AG6P17MS"",$J,"
SET XMY(1)=""
SET XMY(DUZ)=""
+7 FOR %="AGZMENU","XUMGR","XUPROG","XUPROGMODE"
DO SINGLE(%)
+8 DO ^XMD
+9 KILL ^TMP("AG6P17MS",$JOB)
+10 QUIT
+11 ;
DELOPT ; Delete OPTION "AG DDPS HRN DEL"
+1 SET RECNO=0
+2 FOR
SET RECNO=$ORDER(^DIC(19,"B","AG DDPS HRN DEL",RECNO))
IF 'RECNO
QUIT
Begin DoDot:1
+3 SET DIK="^DIC(19,"
SET DA=RECNO
DO ^DIK
End DoDot:1
+4 QUIT
+5 ;
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 ;
+7 ;
INDEXAI ; REINDEX AI XREF PREVIOUS COMMUNITY
+1 ;
+2 ; Thanks to Toni Jarland for the original routine. Aug 17 2001.
+3 ;
+4 ;This runs the AI X-Ref Re-Index of the Previous Communty Multiple
+5 ;$Order through each AUPNPAT Global Entry & Re-Index AI X-Ref
+6 ;The AI X-Ref calls Routine AUPNPCTR which $O thru the Previous
+7 ;Community Multiple & resets the Last Previous Community Entry
+8 ;to fields #1117 Current Community Mulitple & #1118 Current Community
+9 ;Text Value. This will clean up missing Community Pointers used
+10 ;in the Patient Registration Re-export
+11 ;
+12 IF $PIECE($TEXT(+2^AUPNPCTR),";",5)'="**6**"
Begin DoDot:1
+13 DO BMES^XPDUTL("AUPN PATCH 6 IS NOT INSTALLED.")
+14 DO BMES^XPDUTL("THE AI X-REF RE-FIRE WILL BE IN VAIN.")
+15 DO BMES^XPDUTL("INSTALL AUPN 99.1 PATCH 6 AND RUN INDEXAI^AG6P17.")
+16 QUIT
End DoDot:1
QUIT
+17 NEW AGB,AGE
+18 SET AGB=$$NOW^XLFDT
+19 DO BMES^XPDUTL("Begin Re-Indexing AI Cross Reference of PATIENT File, "_$$FMTE^XLFDT(AGB))
+20 IF '$DATA(ZTQUEUED)
WRITE !,"Estimated % complete:",!
+21 NEW AGP3,DA,DIK
+22 SET DA(1)=0
SET DIK(1)=".03^AI"
SET AGP3=$PIECE(^AUPNPAT(0),U,3)
+23 FOR
SET DA(1)=$ORDER(^AUPNPAT(DA(1)))
IF 'DA(1)
QUIT
Begin DoDot:1
+24 SET DIK="^AUPNPAT("_DA(1)_",51,"
+25 DO ENALL^DIK
+26 IF '(DA(1)#100)
IF '$DATA(ZTQUEUED)
WRITE " | ",$JUSTIFY(DA(1)/AGP3*100,0,0),"%"
+27 QUIT
End DoDot:1
+28 ;
+29 SET AGE=$$NOW^XLFDT
+30 DO BMES^XPDUTL("End of Re-Indexing AI Cross Reference of PATIENT File, "_$$FMTE^XLFDT(AGE))
+31 DO BMES^XPDUTL($$FMDIFF^XLFDT(AGE,AGB,2)_" seconds")
+32 QUIT
+33 ;
OPTRES(AGM) ;
+1 DO BMES^XPDUTL("Restoring '"_AGM_"' option to PRE-install configuration...")
+2 NEW AG,AGI
+3 IF '$DATA(^XTMP("AG6P17",6.17,"OPTSAV",AGM))
DO BMES^XPDUTL("FAILED. Option '"_AGM_"' was not previously saved.")
QUIT
+4 SET AG=0
+5 FOR
SET AG=$ORDER(^XTMP("AG6P17",6.17,"OPTSAV",AGM,AG))
IF 'AG
QUIT
SET AGI=^(AG)
IF '$$ADD^XPDMENU(AGM,$PIECE(AGI,U,1),$PIECE(AGI,U,2),$PIECE(AGI,U,3))
DO BMES^XPDUTL("....FAILED to re-atch "_$PIECE(AGI,U,1)_" to "_AGM_".")
+6 QUIT
+7 ;
IP14 ; Items from patch 14.
+1 DO BMES^XPDUTL("Patch 14 was not installed. Performing P14 items...")
+2 ;
+3 DO INDEXAI
+4 ;
+5 DO BMES^XPDUTL("Q'ing Name check report...")
+6 SET ZTRTN="START^AGEDNAME"
SET ZTIO=""
SET ZTDESC=$PIECE($PIECE($TEXT(+1^AGEDNAME),";",2)," ",3,99)
SET ZTDTH=$HOROLOG
+7 DO ^%ZTLOAD
+8 IF $DATA(ZTSK)
DO MES^XPDUTL("Que'd to task "_ZTSK_".")
IF 1
+9 IF '$TEST
DO BMES^XPDUTL("Que of Name check report *FAILED*.")
+10 ;
+11 DO BMES^XPDUTL("Attaching ""AG REP NAME CHECK"" option to menu ""REGISTRATION REPORTS"".")
+12 IF $$ADD^XPDMENU("AGREPORTS","AG REP NAME CHECK","STD",25)
DO BMES^XPDUTL("....successfully atch'd....allocating Security Keys...")
Begin DoDot:1
+13 NEW AG,DA,DIC,DINUM
+14 SET AG=0
SET AG("RPT")=$ORDER(^DIC(19.1,"B","AGZREPORTS",0))
SET AG("STD")=$ORDER(^DIC(19.1,"B","AGZNAMECHECK",0))
+15 IF 'AG("RPT")!'AG("STD")
QUIT
+16 SET DIC(0)="NMQ"
SET DIC("P")="200.051PA"
+17 FOR
SET AG=$ORDER(^XUSEC("AGZREPORTS",AG))
IF 'AG
QUIT
Begin DoDot:2
+18 IF $DATA(^VA(200,AG,51,AG("STD")))
QUIT
+19 SET DIC="^VA(200,AG,51,"
SET DA(1)=AG
SET (DINUM,X)=AG("STD")
+20 DO FILE^DICN
+21 QUIT
End DoDot:2
+22 QUIT
End DoDot:1
IF 1
+23 IF '$TEST
DO BMES^XPDUTL("....Attachment *FAILED*.")
+24 ;
+25 DO BMES^XPDUTL("Attaching ""AGTXALL"" option to the export menu ""AGTX"".")
+26 IF $$ADD^XPDMENU("AGTX","AGTXALL","ALL",10)
DO BMES^XPDUTL("....successfully atch'd.")
DO BMES^XPDUTL("NOTE: Security key will *NOT* be allocated.")
IF 1
+27 IF '$TEST
DO BMES^XPDUTL("....Attachment *FAILED*.")
+28 ;
+29 QUIT
+30 ;
IP15 ;
+1 DO BMES^XPDUTL("Patch 15 was not installed. Performing P15 items...")
+2 ;
+3 DO BMES^XPDUTL("Attaching ""AG TM ELIGIBILITY"" option to the table maintenance menu ""TM"".")
+4 IF $$ADD^XPDMENU("AG TM MENU","AG TM ELIGIBILITY","ELUP",10)
DO BMES^XPDUTL("....successfully atch'd.")
IF 1
+5 IF '$TEST
DO BMES^XPDUTL("....Attachment *FAILED*.")
+6 ;
+7 DO BMES^XPDUTL("Attaching ""AG3PSUM"" option to the the Third Party Billing Reports ""THR"".")
+8 IF $$ADD^XPDMENU("AGBILL","AG3PSUM","AGSM",4)
DO BMES^XPDUTL("....successfully atch'd.")
IF 1
+9 IF '$TEST
DO BMES^XPDUTL("....Attachment *FAILED*.")
+10 ;
+11 IF $$VAL^XBDIQ1(9999999.39,1,.15)'="YES"
Begin DoDot:1
+12 NEW AG
+13 SET AG=0
+14 FOR
SET AG=$ORDER(^ABMDCLM(AG))
IF 'AG
QUIT
IF $$FMDIFF^XLFDT(DT,$ORDER(^ABMDCLM(AG,"AC",9999999),-1),1)<180
Begin DoDot:2
+15 NEW DA,DIE,DR
+16 SET DIE=9999999.39
SET DA=1
SET DR=".15///Y"
+17 DO ^DIE
+18 IF '$DATA(Y)
Begin DoDot:3
+19 DO BMES^XPDUTL("The 'THIRD-PARTY BILLING PRESENT' field in RPMS SITE had been changed to 'YES',")
+20 DO MES^XPDUTL("based on 3PB editing activity in the last 6 months.")
DO MES^XPDUTL("'YES' ensures setting of the 'ABILL' x-ref in the VISIT file.")
+21 QUIT
End DoDot:3
QUIT
+22 DO BMES^XPDUTL("** ERROR: EDIT OF .15 IN RPMS SITE FILE FAILED.")
+23 QUIT
End DoDot:2
QUIT
+24 QUIT
End DoDot:1
+25 QUIT
+26 ;
UPLG ; Fix bug in ^AGELUPLG.
+1 DO BMES^XPDUTL("Fixing bad info in ELIGIBILITY UPLOAD LOG caused by bug...")
+2 NEW AGDA,AGRUN,AGSUB,DA,DFN,DIK
+3 SET AGRUN=0
+4 FOR
SET AGRUN=$ORDER(^AGELUPLG(AGRUN))
IF 'AGRUN
QUIT
Begin DoDot:1
+5 FOR AGSUB=1,2
SET AGDA=0
FOR
SET AGDA=$ORDER(^AGELUPLG(AGRUN,AGSUB,AGDA))
IF '$DATA(ZTQUEUED)
WRITE "."
IF 'AGDA
QUIT
SET DFN=$PIECE(^(AGDA,0),U)
IF AGDA'=DFN
Begin DoDot:2
+6 SET DIK="^AGELUPLG("_AGRUN_","_AGSUB_","
SET DA(1)=AGRUN
SET DA=AGDA
+7 DO ^DIK
+8 DO PTACT^AGELUP2(AGSUB,DFN)
End DoDot:2
+9 QUIT
End DoDot:1
+10 DO MES^XPDUTL("Fix complete.")
+11 QUIT
+12 ;
CMS ; Deactive the CMS Railroad template and re-name both from "HCFA" to "CMS".
+1 DO BMES^XPDUTL("Deactivating HCFA Railroad template, renaming both templates....")
+2 NEW AGY,DIC,X
+3 SET DIC=9009062.01
SET DIC(0)=""
SET X="HCFA RAILROAD RETIREMENT"
+4 DO ^DIC
+5 IF +Y<1
DO MES^XPDUTL("'HCFA RAILROAD RETIREMENT' template not found (that's OK).")
IF 1
+6 IF '$TEST
Begin DoDot:1
+7 NEW DA,DIE,DR
+8 SET AGY=$PIECE(Y,U,2)
SET DA=+Y
SET DIE=DIC
SET DR=".01///CMS RAILROAD RETIREMENT;.07///"_DT
+9 DO ^DIE
+10 DO MES^XPDUTL("'"_AGY_"' template renamed 'CMS RAILROAD RETIREMENT'.")
+11 QUIT
End DoDot:1
+12 SET DIC=9009062.01
SET DIC(0)=""
SET X="HCFA MEDICARE"
+13 DO ^DIC
+14 IF +Y<1
DO MES^XPDUTL("'HCFA MEDICARE' template not found (that's OK).")
IF 1
+15 IF '$TEST
Begin DoDot:1
+16 NEW DA,DIE,DR
+17 SET AGY=$PIECE(Y,U,2)
SET DA=+Y
SET DIE=DIC
SET DR=".01///CMS MEDICARE"
+18 DO ^DIE
+19 DO MES^XPDUTL("'"_AGY_"' template renamed 'CMS MEDICARE'.")
+20 QUIT
End DoDot:1
+21 DO MES^XPDUTL("CMS complete.")
+22 QUIT
+23 ;
TS DO MES^XPDUTL($$HTE^XLFDT($HOROLOG))
QUIT
+1 ;
