source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGYPREG.m@ 1141

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

initial load of WorldVistAEHR

File size: 3.9 KB
RevLine 
[613]1DGYPREG ;ALB/REW - POST-INIT CONVERSION ROUTINES OF PATIENT FILE ;12-MAR-93
2 ;;5.3;Registration;;Aug 13, 1993
3 ;
4EN1(DGDOMB,DGDOCFL) ;
5 ; INPUT:
6 ; DGDOMB - 0=NOTHING, 1=REPORT, 2=REPORT & CONVERSION
7 ; DGDOCFL- "
8EN ;
9 N CT,DGCFLBD,DGCFLCN,DGDAY,DGDJ,DGTOTBD,DGTOTCN,X,XCNP,XMZ
10 S:('$D(DGDOMB))&('$D(DGDOCFL)) (DGDOMB,DGDOCFL)=1
11 N DGSTDT,DGENDT,Y,%
12 D STTIME("Patient File Loop"),LOOP,ENDTIME("Patient File Loop")
13 Q
14STTIME(DGDESC) I '$D(ZTQUEUED) D NOW^%DTC S DGSTDT=$H,DT=X,Y=% W !!,">>> "_DGDESC_" started: " D DT^DIQ W !!
15 Q
16ENDTIME(DGDESC) ; -get stop time
17 I '$D(ZTQUEUED) D NOW^%DTC S DGENDT=$H W:'$D(ZTQUEUED) !!,">>> "_DGDESC_" complete at " S Y=% D DT^DIQ
18 I $D(DGENDT) D
19 .S DGDAY=+DGENDT-(+DGSTDT)*86400 ;additional seconds of over midnight
20 .S X=DGDAY+$P(DGENDT,",",2)-$P(DGSTDT,",",2) W:'$D(ZTQUEUED) !," Elapse time for loop was: ",X\3600," Hours, ",X\60-(X\3600*60)," Minutes, ",X#60," Seconds"
21 Q
22INITLOOP ;
23 S (DGCFLCN,DGCFLBD,DGTOTCN,DGTOTBD)=0
24 S:'$D(DGDOMB)&('$D(DGDOCFL)) (DGDOMB,DGDOCFL)=2
25 Q
26LOOP ;
27 D INITLOOP
28 N DIRUT,DFN,RWVCOM,RWEND,RWSKIP,RWSTOP
29 S RWSKIP=1,RWSTOP=99999999
30 F DFN=0:0 S DFN=$O(^DPT(DFN)) Q:DFN'>0!(DFN>RWSTOP) I '(DFN#RWSKIP) D
31 .W:'$D(ZTQUEUED)&('(DFN#100)) "."
32 .Q:'$D(^DPT(DFN,0))
33 .D:$G(DGDOMB) TOTVAAMT(DFN,(DGDOMB-1)) ;:'$G(^DPT(DFN,.35))
34 .D:$G(DGDOCFL) CFL(DFN,(DGDOCFL-1)) ;:'$G(^DPT(DFN,.35)) - CAN BE ADDED TO NOT HANDLE DEAD
35 D ENDLOOP^DGYPREG3
36 K ^TMP("DGGDCFL",$J),^TMP("DGBDCFL",$J),^TMP("DGGDMB",$J),^TMP("DGBDMB",$J),^TMP("DGCFLREP",$J),^TMP("DGTOTVA",$J)
37 Q
38NOREC(DA,PC) ;RE-STUFFS NO ANSWER TO ACTIVATE DELETION TRIGGER
39 N DIE,DR,DGFLDN
40 G:'$G(DA)!('$G(PC)) QTNOREC
41 S DIE=2
42 S DGFLDN=$S(PC=1:.36205,(PC=2):.36215,(PC=3):.3025,(PC=4):.36235,1:"")
43 G:'DGFLDN QTNOREC
44 S DR=DGFLDN_"////N"
45 D ^DIE
46QTNOREC Q
47TOTVAAMT(DFN,DGOKPOP) ;Populates TOTAL ANNUAL VA CHECK AMOUNT IGNORES 0nnnnn entries
48 ; DGOKPOP = FLAG TO POPULATE FIELD
49 N AMT,CT,DGNODE,DGPCN,DGRECN,PC,X
50 S DGNODE=$G(^DPT(DFN,.362))
51 S DGPCN="12^13^11^14"
52 G:$P(DGNODE,U,20)]"" QTTVMT
53 S AMT(3)=$P($G(^DPT(DFN,.3)),U,3)
54 I $E(AMT(3)) I AMT(3)<99999 D
55 .I $P(^DPT(DFN,.3),U,11)["N" D
56 ..D:$G(DGOKPOP) NOREC(DFN,3)
57 .E S CT=1 S:$G(DGOKPOP) $P(^DPT(DFN,.362),U,20)=AMT(3)
58 F PC=1,2,4 S AMT(PC)=$P(DGNODE,U,PC) I $E(AMT(PC)) I AMT(PC)<99999 D
59 .I $P(DGNODE,U,($P(DGPCN,U,PC)))["N" D
60 ..D:$G(DGOKPOP) NOREC(DFN,PC)
61 .E D
62 ..S CT=$G(CT)+1
63 ..S:$G(DGOKPOP) $P(^DPT(DFN,.362),U,20)=AMT(PC)
64 I $G(CT)>1 D
65 .S:$G(DGOKPOP) $P(^DPT(DFN,.362),U,20)=""
66 .S ^TMP("DGBDMB",$J,(9999999-$$ACTDT(DFN)),DFN)=AMT(1)_U_AMT(2)_U_AMT(3)_U_AMT(4)
67 .S DGTOTBD=$G(DGTOTBD)+1
68 I $G(CT)=1 S DGTOTCN=$G(DGTOTCN)+1 S ^TMP("DGGDMB",$J,(9999999-$$ACTDT(DFN)),DFN)=""
69QTTVMT Q
70CFL(DFN,DGOKPOP) ;SORT ENTRIES AS BAD, NO CONVERSION NEEDED, AND CONVERTIBLE
71 ; DGOKPOP = FLAG TO POPULATE FIELD
72 N DGPTR4
73 S DGPTR4=$$GOODCFL(DFN)
74 G:'DGPTR4 QTCFL
75 I DGPTR4<0 D
76 .S ^TMP("DGBDCFL",$J,(9999999-$$ACTDT(DFN)),DFN)=DGPTR4
77 .S DGCFLBD=$G(DGCFLBD)+1
78 I DGPTR4>0 D
79 .S ^TMP("DGGDCFL",$J,(9999999-$$ACTDT(DFN)),DFN)=DGPTR4
80 .S DGCFLCN=$G(DGCFLCN)+1
81 .S:$G(DGOKPOP) $P(^DPT(DFN,.31),U,4)=+DGPTR4 ;THIS POPULATES NEW FIELD
82QTCFL Q
83GOODCFL(DFN) ;RETURNS POINTER^DESC (TO INSTITUTION FILE),-1 (BAD),0 (NO CHNG)
84 N DGCFL,DGNODE,X
85 ; OUTPUT [RETURNED]POINTER^DGCFL(CLAIM FOLDER LOCATION)
86 S DGNODE=$G(^DPT(DFN,.31))
87 S DGCFL=$P(DGNODE,U,2)
88 I (DGCFL']"")!($P(DGNODE,U,4)]"") S X=0 G QTGCFL
89 I $E(DGCFL,1,3)="000" S X=0 G QTGCFL
90 I 'DGCFL S X=-1 G QTGCFL
91 S X=$O(^DIC(4,"D",+DGCFL,0))
92 I 'X S X=-1
93QTGCFL Q X_U_DGCFL
94ACTDT(DFN) ;RETURNS LAST ACTIVE DATE
95 N A,ACTDT,X,Y
96 S ACTDT=0
97 S X=$O(^DPT(DFN,"DIS",0)) S:X ACTDT=9999999-X ;REG
98 S:$G(^DPT(DFN,.105)) ACTDT=DT ;INPATIENT
99 F A=0:0 S A=$O(^DGS(41.1,"B",DFN,A)) Q:A'>0 S X=$P($G(^DGS(41.1,+A,0)),U,2) S:X>ACTDT ACTDT=X ;ADM
100 S X=ACTDT F S X=$O(^DPT(DFN,"S",X)) S:X Y=X I 'X S:$G(Y)>ACTDT ACTDT=Y Q ;CLIN
101 S X=ACTDT F S X=$O(^DGPM("APRD",DFN,X)) S:X Y=X I 'X S:$G(Y)>ACTDT ACTDT=Y Q ;PM
102QTACTDT Q ACTDT
Note: See TracBrowser for help on using the repository browser.