source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJDE.m@ 724

Last change on this file since 724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.7 KB
Line 
1IBJDE ;ALB/RB - DM DATA EXTRACTION (MAIN ROUTINE) ; 15-APR-99
2 ;;2.0;INTEGRATED BILLING;**100,118,123,235,248,254,244**;21-MAR-94
3 ;
4BJ ; - Entry point from IBAMTC.
5 I $D(^IBE(351.7,"DISABLE")) G ENQ ; DM extraction process disabled.
6 ;
7 I $E(DT,6,7)=$E($$LDATE(DT)+1,6,7) S IBDT=$E($P($$M1(DT,0),"^",1),1,5)_"00"
8 I '$G(IBDT) S IBDT=$$M1(DT,1)
9 I $E(IBDT,6,7)'="00" S IBDT=$E(IBDT,1,5)_"00"
10 I $D(^IBE(351.71,"AC",3,IBDT)) G ENQ ; Extract done for this date.
11 ;
12 D NOW^%DTC S IBRD=%,IBS=$P(%H,",",2)
13 I $D(^IBE(351.71,IBDT,0)) D G ST ; Entry for this date already made.
14 .S DIE="^IBE(351.71,",DR=".02////1;.03////"_IBRD,DA=IBDT D ^DIE
15 .K DA,DIE,DR
16 ;
17 ; - Create entry in IB DM EXTRACT DATA ELEMENTS file (#351.71).
18 S DIC="^IBE(351.71,",DIC(0)="L",DIC("DR")=".02////1;.03////"_IBRD
19 S (DINUM,X)=IBDT K DD,DO D FILE^DICN K DIC,DINUM,DD,DO S IBDT=+Y
20 ;
21ST ; - Start extraction process.
22 I '$$CHK(IBDT) G COMP ; If data from all reports extracted, E-mail file.
23 ;
24 N IBUNBILL
25 I $E(DT,6,7)=$E($$LDATE(DT)+1,6,7) S IBA0=$O(^IBE(351.7,"B","UNBILLED AMOUNTS REPORT",0)) G:'IBA0 ENQ S IBN0=^IBE(351.7,IBA0,0),IBUNBILL=1 D EXTRACT G ENQ
26 S IBA0=0 F S IBA0=$O(^IBE(351.7,IBA0)) Q:'IBA0 S IBN0=^(IBA0,0) I $P(IBN0,"^",1)'="UNBILLED AMOUNTS REPORT" S IBUNBILL=0 D EXTRACT
27 G ENQ
28 ;
29EXTRACT I $P(IBN0,U,2) Q ; Report has been disabled.
30 I $D(^IBE(351.71,"AD",3,IBDT,IBA0)) Q ; Extract of report done.
31 ;
32 I '$D(^IBE(351.71,IBDT,1,IBA0,0)) D ; Create REPORT sub-file entry.
33 .S DIC="^IBE(351.71,"_IBDT_",1,",DIC(0)="L",DIC("DR")=".02////1"
34 .S DIC("P")="351.711P",DA(1)=IBDT,(DA,DINUM,X)=IBA0 K DD,DO
35 .D FILE^DICN K DA,DIC,DINUM,DD,DO
36 ;
37 ; - Set input variables.
38 S IBA1=0 N ZTIO,ZTDESC,ZTSK,ZTDTH,ZTRTN,ZTSAVE
39 F S IBA1=$O(^IBE(351.7,IBA0,1,IBA1)) Q:'IBA1 S IBN1=$G(^(IBA1,0)) D
40 .I $D(^IBE(351.7,IBA0,1,IBA1,1)) X ^(1)
41 .E S IBV=$P(IBN1,U),@(IBV)=$P(IBN1,U,2),ZTSAVE(IBV)=""
42 ;
43 ; - Set other ZT* variables for queueing.
44 S ZTSAVE("IBUNBILL")=""
45 S ZTDESC=$P(IBN0,U),ZTSAVE("IBXTRACT")=1,ZTIO=""
46 I $G(IBX) S ZTSAVE("IBXDATE")=IBDT ; Date from DME manual start option.
47 S ZTRTN=$G(^IBE(351.7,IBA0,2)) Q:ZTRTN="" I ZTRTN'["^" S ZTRTN=U_ZTRTN
48 S IBS=IBS+300,%=IBS D S^%DTC S ZTDTH=$P(IBRD,".")_% ; Run in 5 mins.
49 D ^%ZTLOAD
50 Q
51 ;
52 ;
53E(RI,J) ; - Change report extract status/load DM summary report data.
54 ; Input: RI=Report IEN from IB DM EXTRACT REPORTS file (#351.7).
55 ; J=1-Change status, 0=Load DM data
56 S IBDT=$S($G(IBXDATE):$E(IBXDATE,1,5)_"00",'$G(IBUNBILL):$$M1(DT,1),1:$E($P($$M1(DT,0),"^",1),1,5)_"00") I 'J G E1
57 ;
58 I '$D(^IBE(351.71,"AC",2,IBDT)) D ; Change extract status to STARTED.
59 .D NOW^%DTC S DIE="^IBE(351.71,",DR=".02////2;.03////"_%,DA=IBDT D ^DIE
60 .K DA,DIE,DR
61 ;
62 ; - Change report extract status to EXTRACT STARTED.
63 I '$D(^IBE(351.71,"AD",2,IBDT,RI)) D
64 .D NOW^%DTC S DIE="^IBE(351.71,"_IBDT_",1,",DR=".02////2;.03////"_%
65 .S DA(1)=IBDT,DA=RI D ^DIE K DA,DIE,DR
66 ;
67 G ENQ
68 ;
69E1 ; - Load DM summary report data into file #351.71.
70 I $G(IBUNBILL) G E2
71 S IBA0=0 F S IBA0=$O(^IBE(351.701,"C",RI,IBA0)) Q:'IBA0 D
72 .S IBN0=$P($G(^IBE(351.701,IBA0,0)),U,2) Q:IBN0="" S IBN0=@(IBN0)
73 .;
74 .; - Create DATA ELEMENT sub-file entry in REPORT sub-file of #351.71
75 .S DIC="^IBE(351.71,"_IBDT_",1,"_RI_",1,",DIC(0)="L"
76 .S DIC("DR")=".02////"_IBN0,DIC("P")="351.7111P",DA(2)=IBDT,DA(1)=RI
77 .S (DA,DINUM,X)=IBA0 K DD,DO D FILE^DICN K DA,DIC,DINUM,DD,DO
78 ;
79 ; - Change status in REPORT sub-file of #351.71 to EXTRACT COMPLETED.
80E2 D NOW^%DTC S DIE="^IBE(351.71,"_IBDT_",1,",DR=".02////3;.04////"_%
81 S DA(1)=IBDT,DA=RI D ^DIE K DA,DIE,DR,IBXDATE,IBXTRACT
82 ;
83 ; - Check if all data from all reports have been extracted, then change
84 ; status in file #351.71 entry to EXTRACT COMPLETED.
85 I $$CHK(IBDT) G ENQ ; All reports not completed yet.
86 ;
87COMP D NOW^%DTC
88 S DIE="^IBE(351.71,",DR=".02////3;.04////"_%,DA=IBDT D ^DIE K DA,DIE,DR
89 I '$P(^IBE(351.71,IBDT,0),U,5) D XM^IBJDE1(IBDT) ; Transmit extract.
90 ;
91ENQ I '$G(IBX) K IBDT
92 K IBA0,IBA1,IBCT,IBN0,IBN1,IBRD,IBS,IBV,IBV1,X,Y,%
93 Q
94 ;
95M1(X,Y) ; - Return first/last day of month (if Y=0), previous month (if Y=1),
96 ; first/last day of month in MMDDYYYY format (if Y=2), or date in
97 ; external format (if Y=3).
98 N X1,X2 S:'$G(X)!(X'?7N.1".".6N) X=DT S:'$G(Y) Y=0
99 S X2="31^"_$S($E(X,1,3)#4=0:29,1:28)_"^31^30^31^30^31^31^30^31^30^31"
100 I 'Y S X=$E(X,1,5),X=X_"01"_U_X_$P(X2,U,+$E(X,4,5)) G M1Q
101 I Y=1 S X=($E(X,1,5)_"00")-$S(+$E(X,4,5)=1:8900,1:100) G M1Q
102 I Y=2 D G M1Q
103 .S X1=1700+$E(X,1,3),X=$E(X,4,5),X=X_"01"_X1_U_X_$P(X2,U,+X)_X1
104 S Y=X X ^DD("DD") S X=Y
105M1Q Q X
106 ;
107M2(X,Y,Z,R) ; - Return specific date range.
108 ; Input: X=Date in Fileman format
109 ; Y=Number of months back from X
110 ; Z=Number of months ahead from date created via Y
111 ; R=0-Date range in Fileman format, 1-In MMDDYYYY format
112 N X1,X2
113 S:'$G(X) X=DT S:'$G(Y) Y=1 S:'$G(Z) Z=1 S:'$G(R) R=0 I X'?7N S X=DT
114 S X=$E(X,1,5)
115 S X1="31^"_$S($E(X,1,3)#4=0:29,1:28)_"^31^30^31^30^31^31^30^31^30^31"
116 F X2=1:1:Y S X=X-$S(+$E(X,4,5)=1:89,1:1) I X2=Y S X3=X_"01"
117 F X2=1:1:Z S X=X+$S(+$E(X,4,5)=12:89,1:1)
118 S X=X3_U_X_$P(X1,U,+$E(X,4,5)) I 'R G M2Q
119 S X1=1700+$E(X,1,3),X2=1700+$E(X,9,11),X=$E(X,4,7)_X1_U_$E(X,12,15)_X2
120M2Q Q X
121 ;
122M3(X) ;Beginning date 365 days prior
123 N X1,X2
124 S X1=X,X2=-365 D C^%DTC
125 Q X
126CHK(X) ; - Check if all extract reports have completed.
127 ; Input: X=Date IEN of entry in file #351.71
128 ; Output: Y=0-Completed, 1-Not completed
129 N X1,X2,X3 S (X1,X2,X3,Y)=0
130 F S X1=$O(^IBE(351.7,X1)) Q:'X1 I '$P(^(X1,0),U,2) S X2=X2+1
131 S X1=0 F S X1=$O(^IBE(351.71,"AD",3,X,X1)) Q:'X1 S X3=X3+1
132 I X2'=X3 S Y=1
133 Q Y
134LDATE(X) ; DETERMINE CUT-OFF DATE FOR THE MONTH
135 S X=$E(X,1,5)_$P("31^28^31^30^31^30^31^31^30^31^30^31","^",+$E(X,4,5))
136 I +$E(X,6,7)=28,$E(X,2,3)#4=0 S $E(X,6,7)=29
137 S X=$$WORKPLUS^XUWORKDY(X,-3)
138 Q X
Note: See TracBrowser for help on using the repository browser.