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

IBQYPT.m

Go to the documentation of this file.
  1. IBQYPT ;ALB/CPM - POST-INITIALIZATION FOR PATCH IBQ*1*1 ; 04-DEC-95
  1. ;;1.0;UTILIZATION MGMT ROLLUP LOCAL;**1**;Oct 01, 1995
  1. ;
  1. ;
  1. EN ; Patch IBQ*1*1 post-initialization.
  1. ;
  1. D RECNVT ; re-convert HR Acute Care Discharge Date to CT entries
  1. D COMP ; post completed-installation message
  1. Q
  1. ;
  1. ;
  1. RECNVT ; Perform re-conversion.
  1. ;
  1. W !!,">>> Re-converting data from file #356.1 to #356..."
  1. ;
  1. D DEL ; delete previous values from file #356
  1. D UPD ; re-run the #356.1 -> #356 conversion
  1. ;
  1. Q
  1. ;
  1. ;
  1. DEL ; Delete data previously converted to file #356.
  1. ;
  1. W !," >> Deleting data previously converted to file #356..."
  1. ;
  1. S IBD=0 F S IBD=$O(^IBT(356,"ADIS",IBD)) Q:'IBD D
  1. .S IBT=0 F S IBT=$O(^IBT(356,"ADIS",IBD,IBT)) Q:'IBT D
  1. ..S DIE="^IBT(356,",DA=IBT,DR="1.09////@" D ^DIE K DA,DIE,DR
  1. ;
  1. W " done."
  1. K IBD,IBT
  1. Q
  1. ;
  1. UPD ; Re-run the conversion of data from file #356.1 to file #356.
  1. ;
  1. W !," >> Re-running the conversion of data from file #356.1 to #356..."
  1. ;
  1. S IBTRV=0 F S IBTRV=$O(^IBT(356.1,IBTRV)) Q:'IBTRV D
  1. .;
  1. .; - find the Acute Care Discharge Date
  1. .S IBQACDD=$P($G(^IBT(356.1,IBTRV,1)),"^",17)
  1. .Q:'IBQACDD
  1. .;
  1. .; - find the corresponding Claims Tracking entry
  1. .S IBTRN=$P($G(^IBT(356.1,IBTRV,0)),"^",2)
  1. .Q:'IBTRN Q:'$G(^IBT(356,IBTRN,0))
  1. .;
  1. .; - update field #1.09 in file #356
  1. .S DIE="^IBT(356,",DA=IBTRN,DR="1.09////"_IBQACDD D ^DIE
  1. ;
  1. W " done."
  1. K DA,DR,DIE,IBQACDD,IBTRN,IBTRV
  1. Q
  1. ;
  1. ;
  1. COMP ; Post installation completion message.
  1. ;
  1. D NOW^%DTC S IBQEDT=$H
  1. W !!,">>> Initialization Complete at " S Y=% D DT^DIQ
  1. I $D(IBQBDT) D
  1. .S IBQDAY=+IBQEDT-(+IBQBDT)*86400 ;additional seconds of over midnight
  1. .S X=IBQDAY+$P(IBQEDT,",",2)-$P(IBQBDT,",",2)
  1. .W !," Elapsed time for initialization was: ",X\3600," Hours, ",X\60-(X\3600*60)," Minutes, ",X#60," Seconds"
  1. ;
  1. W !!," *** You may now roll up your QM data for transmission ***"
  1. W !," Please note that you must roll up and transmit your data again if"
  1. W !," you had done so prior to installing this patch."
  1. ;
  1. K IBQBDT,IBQEDT,IBQDAY
  1. Q