- IBQYPT ;ALB/CPM - POST-INITIALIZATION FOR PATCH IBQ*1*1 ; 04-DEC-95
- ;;1.0;UTILIZATION MGMT ROLLUP LOCAL;**1**;Oct 01, 1995
- ;
- ;
- EN ; Patch IBQ*1*1 post-initialization.
- ;
- D RECNVT ; re-convert HR Acute Care Discharge Date to CT entries
- D COMP ; post completed-installation message
- Q
- ;
- ;
- RECNVT ; Perform re-conversion.
- ;
- W !!,">>> Re-converting data from file #356.1 to #356..."
- ;
- D DEL ; delete previous values from file #356
- D UPD ; re-run the #356.1 -> #356 conversion
- ;
- Q
- ;
- ;
- DEL ; Delete data previously converted to file #356.
- ;
- W !," >> Deleting data previously converted to file #356..."
- ;
- S IBD=0 F S IBD=$O(^IBT(356,"ADIS",IBD)) Q:'IBD D
- .S IBT=0 F S IBT=$O(^IBT(356,"ADIS",IBD,IBT)) Q:'IBT D
- ..S DIE="^IBT(356,",DA=IBT,DR="1.09////@" D ^DIE K DA,DIE,DR
- ;
- W " done."
- K IBD,IBT
- Q
- ;
- UPD ; Re-run the conversion of data from file #356.1 to file #356.
- ;
- W !," >> Re-running the conversion of data from file #356.1 to #356..."
- ;
- S IBTRV=0 F S IBTRV=$O(^IBT(356.1,IBTRV)) Q:'IBTRV D
- .;
- .; - find the Acute Care Discharge Date
- .S IBQACDD=$P($G(^IBT(356.1,IBTRV,1)),"^",17)
- .Q:'IBQACDD
- .;
- .; - find the corresponding Claims Tracking entry
- .S IBTRN=$P($G(^IBT(356.1,IBTRV,0)),"^",2)
- .Q:'IBTRN Q:'$G(^IBT(356,IBTRN,0))
- .;
- .; - update field #1.09 in file #356
- .S DIE="^IBT(356,",DA=IBTRN,DR="1.09////"_IBQACDD D ^DIE
- ;
- W " done."
- K DA,DR,DIE,IBQACDD,IBTRN,IBTRV
- Q
- ;
- ;
- COMP ; Post installation completion message.
- ;
- D NOW^%DTC S IBQEDT=$H
- W !!,">>> Initialization Complete at " S Y=% D DT^DIQ
- I $D(IBQBDT) D
- .S IBQDAY=+IBQEDT-(+IBQBDT)*86400 ;additional seconds of over midnight
- .S X=IBQDAY+$P(IBQEDT,",",2)-$P(IBQBDT,",",2)
- .W !," Elapsed time for initialization was: ",X\3600," Hours, ",X\60-(X\3600*60)," Minutes, ",X#60," Seconds"
- ;
- W !!," *** You may now roll up your QM data for transmission ***"
- W !," Please note that you must roll up and transmit your data again if"
- W !," you had done so prior to installing this patch."
- ;
- K IBQBDT,IBQEDT,IBQDAY
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBQYPT 2115 printed Feb 19, 2025@00:07:54 Page 2
- IBQYPT ;ALB/CPM - POST-INITIALIZATION FOR PATCH IBQ*1*1 ; 04-DEC-95
- +1 ;;1.0;UTILIZATION MGMT ROLLUP LOCAL;**1**;Oct 01, 1995
- +2 ;
- +3 ;
- EN ; Patch IBQ*1*1 post-initialization.
- +1 ;
- +2 ; re-convert HR Acute Care Discharge Date to CT entries
- DO RECNVT
- +3 ; post completed-installation message
- DO COMP
- +4 QUIT
- +5 ;
- +6 ;
- RECNVT ; Perform re-conversion.
- +1 ;
- +2 WRITE !!,">>> Re-converting data from file #356.1 to #356..."
- +3 ;
- +4 ; delete previous values from file #356
- DO DEL
- +5 ; re-run the #356.1 -> #356 conversion
- DO UPD
- +6 ;
- +7 QUIT
- +8 ;
- +9 ;
- DEL ; Delete data previously converted to file #356.
- +1 ;
- +2 WRITE !," >> Deleting data previously converted to file #356..."
- +3 ;
- +4 SET IBD=0
- FOR
- SET IBD=$ORDER(^IBT(356,"ADIS",IBD))
- if 'IBD
- QUIT
- Begin DoDot:1
- +5 SET IBT=0
- FOR
- SET IBT=$ORDER(^IBT(356,"ADIS",IBD,IBT))
- if 'IBT
- QUIT
- Begin DoDot:2
- +6 SET DIE="^IBT(356,"
- SET DA=IBT
- SET DR="1.09////@"
- DO ^DIE
- KILL DA,DIE,DR
- End DoDot:2
- End DoDot:1
- +7 ;
- +8 WRITE " done."
- +9 KILL IBD,IBT
- +10 QUIT
- +11 ;
- UPD ; Re-run the conversion of data from file #356.1 to file #356.
- +1 ;
- +2 WRITE !," >> Re-running the conversion of data from file #356.1 to #356..."
- +3 ;
- +4 SET IBTRV=0
- FOR
- SET IBTRV=$ORDER(^IBT(356.1,IBTRV))
- if 'IBTRV
- QUIT
- Begin DoDot:1
- +5 ;
- +6 ; - find the Acute Care Discharge Date
- +7 SET IBQACDD=$PIECE($GET(^IBT(356.1,IBTRV,1)),"^",17)
- +8 if 'IBQACDD
- QUIT
- +9 ;
- +10 ; - find the corresponding Claims Tracking entry
- +11 SET IBTRN=$PIECE($GET(^IBT(356.1,IBTRV,0)),"^",2)
- +12 if 'IBTRN
- QUIT
- if '$GET(^IBT(356,IBTRN,0))
- QUIT
- +13 ;
- +14 ; - update field #1.09 in file #356
- +15 SET DIE="^IBT(356,"
- SET DA=IBTRN
- SET DR="1.09////"_IBQACDD
- DO ^DIE
- End DoDot:1
- +16 ;
- +17 WRITE " done."
- +18 KILL DA,DR,DIE,IBQACDD,IBTRN,IBTRV
- +19 QUIT
- +20 ;
- +21 ;
- COMP ; Post installation completion message.
- +1 ;
- +2 DO NOW^%DTC
- SET IBQEDT=$HOROLOG
- +3 WRITE !!,">>> Initialization Complete at "
- SET Y=%
- DO DT^DIQ
- +4 IF $DATA(IBQBDT)
- Begin DoDot:1
- +5 ;additional seconds of over midnight
- SET IBQDAY=+IBQEDT-(+IBQBDT)*86400
- +6 SET X=IBQDAY+$PIECE(IBQEDT,",",2)-$PIECE(IBQBDT,",",2)
- +7 WRITE !," Elapsed time for initialization was: ",X\3600," Hours, ",X\60-(X\3600*60)," Minutes, ",X#60," Seconds"
- End DoDot:1
- +8 ;
- +9 WRITE !!," *** You may now roll up your QM data for transmission ***"
- +10 WRITE !," Please note that you must roll up and transmit your data again if"
- +11 WRITE !," you had done so prior to installing this patch."
- +12 ;
- +13 KILL IBQBDT,IBQEDT,IBQDAY
- +14 QUIT