- 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 ;
