source: FOIAVistA/trunk/r/INCOMPLETE_RECORDS_TRACKING-DGJ/DGJTUTL.m@ 748

Last change on this file since 748 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1DGJTUTL ;ALB/MIR - ZSECUTABLE HELP FOR EVENT DATE IN INCOMPLETE RECORD FILE ; 04 JAN 91
2 ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
3 N DFN,I,J,OK,PTF S DFN=+^VAS(393,DA,0)
4 D WARN
5 ;
6 W !,"Choose from:"
7 F I=0:0 S I=$O(^UTILITY("DGJTADM",$J,I)) Q:'I S Y=+^DGPM(I,0) X ^DD("DD") W !?5,Y
8 ;
9PTF ;Check to make sure PTF exists and it is not closed
10 S OK=$S('$D(^DGPT(+PTF)):0,$D(^DGP(45.84,+PTF)):0,1:1)
11 Q
12PHYSRTRG S DGJTEST=$P(^VAS(393,D0,0),"^",11) S X=$S(DGJTEST=$O(^DG(393.2,"B","TRANSCRIBED",0)):0,DGJTEST=$O(^DG(393.2,"B","SIGNED",0)):0,DGJTEST=$O(^DG(393.2,"B","REVIEWED",0)):0,1:1) K DGJTEST Q
13LESS48 ;Checking for discharge summary less than 48 hours.
14 I $D(^VAS(393,DA,"DT")),$P(^("DT"),"^",1)]"" S X=0 Q
15 S (DGJTX4,X1)=$P(^DGPM(+$P(DGJTNO,"^",4),0),"^",1),DGJTX3=+$P(DGJTNO,"^",3) S X2=2 D C^%DTC I DGJTX3<X&($P(DGJTNO,"^",3)>DGJTX4) D ASK K DGJTX3,DGJTX4
16 Q
17ASK W !!,"Will this Discharge Summary <48 hrs need to be dictated? "
18 S %=2 D YN^DICN I '% W !,"ENTER:",!?10,"Y for YES",!?10,"N for NO",!?10,"^ to EXIT" G ASK
19 S X=$S(%=2:1,%=-1:"-1",1:0)
20 Q
21TS D FULL^VALM1 D EXP^DGJTEE1 G TSQ
22TSQ D EVDT^DGJTEE S VALMBG=1,VALMBCK="R" Q
23WARN K ^UTILITY("DGJTADM",$J)
24 S DGJTCNT=0 F I=0:0 S I=$O(^DGPM("ATID1",DFN,I)) Q:'I S IFN=$O(^(I,0)) I $D(^DGPM(IFN,0)),($P(^(0),"^",2)=1) S DGJTCNT=DGJTCNT+1,^UTILITY("DGJTADM",$J,DGJTCNT,IFN)=""
25 I '$D(^UTILITY("DGJTADM",$J)) W !!,*7," Patient has no admissions on file in this facility",! Q
26 K OK,I,PTF
27 Q
28 ;
29 ;
30WR ;write node from delinquent records file
31 N X,Y
32 S X=$P(DGJT,"^",2)
33 W $S(X]""&($D(^VAS(393.3,+X,0))):$P(^VAS(393.3,+X,0),"^",1),1:"UNKNOWN DEFICIENCY")
34 S Y=$P(DGJT,"^",3) I Y]"" X ^DD("DD") W ?45,Y
35 Q
36 ;
37 ;
38WARD ; -- find last ward for event driver
39 ; input CA = ifn of cors adm
40 N IDT,MVT,M
41 S X=""
42 F IDT=0:0 S IDT=$O(^DGPM("APMV",DFN,CA,IDT)) Q:'IDT F MVT=0:0 S MVT=$O(^DGPM("APMV",DFN,CA,IDT,MVT)) Q:'MVT I $D(^DGPM(MVT,0)) S M=^(0) I "^13^43^44^45^"'[(U_$P(M,U,18)_U),$D(^DIC(42,+$P(M,U,6),0)) S X=+$P(M,U,6) G WARDQ
43WARDQ Q
44PHYDEF ;Cross-reference on the Date Transcribed,10.03; Transcribed By,10.04
45 ; Date Signed,10.05; Signed By,10.06
46 ;to update the Physician for Deficiency field (#.14)
47 ;in the Incomplete Records Tracking file (#393)
48 N DGJX,DGJTNOD,DGJTDV,DGJTDN,DGJTPD,DGJNDT
49 S DGJTNOD=$G(^VAS(393,DA,0)),DGJTDV=$P(DGJTNOD,"^",6)
50 S DGJTDV=$G(^DG(40.8,DGJTDV,"DT"))
51 I $D(DGJATTD) I $P(DGJTNOD,"^",11)=$O(^DG(393.2,"B","TRANSCRIBED",0))&($P(DGJTDV,"^",10)="A")!($P(DGJTNOD,"^",11)=$O(^DG(393.2,"B","SIGNED",0))&($P(DGJTDV,"^",4)="A")) S DGJX=$P(DGJTNOD,"^",10) D SET K DGJATTD Q
52 S DGJTPD=$P(DGJTNOD,"^",14)
53 S DGJNDT=$G(^VAS(393,DA,"DT"))
54 I $D(DGJFDIC) D K DGJFDIC Q
55 .S DGJX=$S($P(DGJNDT,"^",2)]""&($P(DGJNDT,"^",1)]""):$P(DGJNDT,"^",2),$P(DGJTNOD,"^",12)]"":$P(DGJTNOD,"^",12),1:$P(DGJTNOD,"^",9)) D SET Q
56 I $D(DGJFSIG) D K DGJFSIG Q
57 .I $P(DGJNDT,"^",3)']""!($P(DGJNDT,"^",4)']"") S DGJX=$S($P(DGJNDT,"^",2)]"":$P(DGJNDT,"^",2),$P(DGJTNOD,"^",12)]"":$P(DGJTNOD,"^",12),1:$P(DGJTNOD,"^",9)) D SET Q
58 .S DGJX=$S($P(DGJTDV,"^",10)="P":$P(DGJTNOD,"^",9),$P(DGJTDV,"^",10)="A":$P(DGJTNOD,"^",10),1:"") Q:DGJX=DGJTPD D SET Q
59 I $D(DGJFREV) D K DGJFREV Q
60 .I $P(DGJNDT,"^",5)']""!($P(DGJNDT,"^",6)']"") I $P(DGJNDT,"^",2)]"" S DGJX=$S($P(DGJTDV,"^",10)="P":$P(DGJTNOD,"^",9),$P(DGJTDV,"^",10)="A":$P(DGJTNOD,"^",10),1:"") D SET Q
61 .I $P(DGJNDT,"^",5)']""!($P(DGJNDT,"^",6)']"") I $P(DGJNDT,"^",2)']"" S DGJX=$S($P(DGJTNOD,"^",12)]"":$P(DGJTNOD,"^",12),$P(DGJTNOD,"^",9)]"":$P(DGJTNOD,"^",9),1:"") D SET Q
62 .S DGJX=$S($P(DGJTDV,"^",3)=0:$P(DGJNDT,"^",6),$P(DGJTDV,"^",4)="P":$P(DGJTNOD,"^",9),$P(DGJTDV,"^",4)="A":$P(DGJTNOD,"^",10),1:"") D SET Q
63 I $D(DGJREVD) D K DGJREVD Q
64 .I $P(DGJNDT,"^",7)']""!($P(DGJNDT,"^",8)']"") S DGJX=$S($P(DGJTDV,"^",4)="P":$P(DGJTNOD,"^",9),$P(DGJTDV,"^",4)="A":$P(DGJTNOD,"^",10),1:"") D SET Q
65 .S DGJX=$S($P(DGJNDT,"^",7)]""&($P(DGJNDT,"^",8)]""):$P(DGJNDT,"^",8),$P(DGJTDV,"^",4)="P":$P(DGJTNOD,"^",9),$P(DGJTDV,"^",4)="A":$P(DGJTNOD,"^",10),1:"") D SET Q
66 Q
67SET S $P(^VAS(393,DA,0),"^",14)=DGJX Q
68Q K DGJTDV,DGJTDEL
69QUIT K DA,DFN,DIC,DIE,DIR,DR,DTOUT,I,IFN,PTF,VAIP,DGA1,DGJC,DGJT,DGJTADN,DGJTAIFN,DGJTADTP,DGJTAT,DGJTCNT,DGJTCT,DGJTDT,DGJTDBY,DGJTDD,DGJTEDT,DGJTOUT,DGJTOA,DGJTOUT,DGJTRC,DGJTSBY,DGJTSDT,DGJTSP,DGJTSV,DGJTST,DGJTTBY,DGJTWD1,DGJFFL,DGJTPR
70 K DGT,DGJTCFLG,DGJTSDT,DGJTTBY,DGJTTD,DGJTYP,DGJTWD,DGJTX,DGPM2X,DGPMCA,DGPMDCD,DGPMT,DGPMVI,DGPMY,DIV,X,^UTILITY("DGJTADM",$J),Y,OK,POP,VAERR,DGJT1PH,DGJT2PH,DGJTCH,DGJTCH1,DGJTFG,DGJTFL,DGJTDDT,DGJTF,VAINDT
71 K DIC("S"),DIC("A") Q
Note: See TracBrowser for help on using the repository browser.