source: FOIAVistA/trunk/r/UTILIZATION_MGMT_ROLLUP_LOCAL-IBQ/IBQYPT.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.0 KB
Line 
1IBQYPT ;ALB/CPM - POST-INITIALIZATION FOR PATCH IBQ*1*1 ; 04-DEC-95
2 ;;1.0;UTILIZATION MGMT ROLLUP LOCAL;**1**;Oct 01, 1995
3 ;
4 ;
5EN ; Patch IBQ*1*1 post-initialization.
6 ;
7 D RECNVT ; re-convert HR Acute Care Discharge Date to CT entries
8 D COMP ; post completed-installation message
9 Q
10 ;
11 ;
12RECNVT ; Perform re-conversion.
13 ;
14 W !!,">>> Re-converting data from file #356.1 to #356..."
15 ;
16 D DEL ; delete previous values from file #356
17 D UPD ; re-run the #356.1 -> #356 conversion
18 ;
19 Q
20 ;
21 ;
22DEL ; Delete data previously converted to file #356.
23 ;
24 W !," >> Deleting data previously converted to file #356..."
25 ;
26 S IBD=0 F S IBD=$O(^IBT(356,"ADIS",IBD)) Q:'IBD D
27 .S IBT=0 F S IBT=$O(^IBT(356,"ADIS",IBD,IBT)) Q:'IBT D
28 ..S DIE="^IBT(356,",DA=IBT,DR="1.09////@" D ^DIE K DA,DIE,DR
29 ;
30 W " done."
31 K IBD,IBT
32 Q
33 ;
34UPD ; Re-run the conversion of data from file #356.1 to file #356.
35 ;
36 W !," >> Re-running the conversion of data from file #356.1 to #356..."
37 ;
38 S IBTRV=0 F S IBTRV=$O(^IBT(356.1,IBTRV)) Q:'IBTRV D
39 .;
40 .; - find the Acute Care Discharge Date
41 .S IBQACDD=$P($G(^IBT(356.1,IBTRV,1)),"^",17)
42 .Q:'IBQACDD
43 .;
44 .; - find the corresponding Claims Tracking entry
45 .S IBTRN=$P($G(^IBT(356.1,IBTRV,0)),"^",2)
46 .Q:'IBTRN Q:'$G(^IBT(356,IBTRN,0))
47 .;
48 .; - update field #1.09 in file #356
49 .S DIE="^IBT(356,",DA=IBTRN,DR="1.09////"_IBQACDD D ^DIE
50 ;
51 W " done."
52 K DA,DR,DIE,IBQACDD,IBTRN,IBTRV
53 Q
54 ;
55 ;
56COMP ; Post installation completion message.
57 ;
58 D NOW^%DTC S IBQEDT=$H
59 W !!,">>> Initialization Complete at " S Y=% D DT^DIQ
60 I $D(IBQBDT) D
61 .S IBQDAY=+IBQEDT-(+IBQBDT)*86400 ;additional seconds of over midnight
62 .S X=IBQDAY+$P(IBQEDT,",",2)-$P(IBQBDT,",",2)
63 .W !," Elapsed time for initialization was: ",X\3600," Hours, ",X\60-(X\3600*60)," Minutes, ",X#60," Seconds"
64 ;
65 W !!," *** You may now roll up your QM data for transmission ***"
66 W !," Please note that you must roll up and transmit your data again if"
67 W !," you had done so prior to installing this patch."
68 ;
69 K IBQBDT,IBQEDT,IBQDAY
70 Q
Note: See TracBrowser for help on using the repository browser.