source: FOIAVistA/trunk/r/INCOMPLETE_RECORDS_TRACKING-DGJ/DGJOPRT1.m@ 674

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

initial load of FOIAVistA 6/30/08 version
File size: 4.7 KB
Line 
1DGJOPRT1 ;MAF/ALB - INCOMPLETE REPORTS ; SEP 11 1991@10:00
2 ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
3 ;
4 I $D(DGJTMUL),DGJTMUL D DIVISION^VAUTOMA G:Y=-1 QUIT
5 I 'DGJTMUL S DGJTDV=$O(^DG(40.8,0))
6 D @(DGJTL) G:Y=-1 QUIT
7 I DGJTL'="DAT" D DAT G:Y=-1 QUIT
8 S DIC("S")="I $S(""^OP REPORT^INTERIM SUMMARY^DISCHARGE SUMMARY^""[$P(^VAS(393.3,+Y,0),U,1):1,1:0)"
9 S VAUTVB="VAUTY",DIC="^VAS(393.3,",VAUTSTR="Summary Type",VAUTNI=2 D FIRST^VAUTOMA Q:Y=-1
10 W !!,*7,"This output requires 132 column output",!
11 D NOW^%DTC S Y=$E(%,1,12) S VADAT("W")=Y D ^VADATE S DGJTDAT=VADATE("E")
12 S DGVAR="DGJTDV^DGJTDIR^DGJTDAT^DGJTSTAT^DGJTCK^DGJTFL^DGJTMESS^DGJTSR^DGJTSR1^DGJTMUL^DGJTL^DGJTBG^DGJTEND^VAUTD#^VAUTN#^VAUTT#^VAUTY#",DGPGM="START^DGJOPRT1" D ZIS^DGJUTQ I 'POP U IO G START^DGJOPRT1
13 G QUIT
14START S (DGJTPAG,DGJTDV1)=0 F IFN=0:0 S IFN=$O(^VAS(393,IFN)) Q:'IFN S DGJTNODE=^VAS(393,IFN,0) D CK
15 I $D(^UTILITY("VAS",$J)) S (DGJ,DGJTF,DGJTFF,DGJY,DGJTDV,DGJTDT,DGJTSV,DGJTSP,DGJTPHY,DGJTPT,DGU,DFN,IFN)=0,$P(DGJTLN,"=",133)="" G ^DGJOPRT2
16 I '$D(^UTILITY("VAS",$J)) W !!,"NO RECORDS"
17QUIT K %DT,DIR,DGJTCK,DGJTBEG,DGJTBG,DGJTEND,DGJRTYP,DGJTDAT,DGJTDV,DGJFL,DGJTDIR,DGJTL,DGJTMESS,DGJTMUL,DGJTSR,DGJTSR1,DGJTSTAT,VAUTD,VAUTN,VAUTT,VADAT,VADATE,POP,X,Y
18 D CLOSE^DGJUTQ Q
19CNT I DGJTL'="SER" S DGJTOT(DGJTDVN)=DGJTOT(DGJTDVN)+1
20 I DGJTL="SER" S DGJTOT(X)=DGJTOT(X)+1
21 I DGJTL="PHY" S:'$D(DGJPHTOT(DGJTDVN,DGJTPHY)) DGJPHTOT(DGJTDVN,DGJTPHY)=0 S DGJPHTOT(DGJTDVN,DGJTPHY)=DGJPHTOT(DGJTDVN,DGJTPHY)+1 Q
22 I DGJTL="SER" S:'$D(DGJSVTOT(DGJTDVN,DGJTSV)) DGJSVTOT(DGJTDVN,DGJTSV)=0 S DGJSVTOT(DGJTDVN,DGJTSV)=DGJSVTOT(DGJTDVN,DGJTSV)+1
23 I DGJTL="SER" S:'$D(DGJSPTOT(DGJTDVN,DGJTSV,DGJTSP)) DGJSPTOT(DGJTDVN,DGJTSV,DGJTSP)=0 S DGJSPTOT(DGJTDVN,DGJTSV,DGJTSP)=DGJSPTOT(DGJTDVN,DGJTSV,DGJTSP)+1
24 Q
25CK I $P(DGJTNODE,"^",6)']"" S $P(DGJTNODE,"^",6)=$O(^DG(40.8,0))
26 I $D(VAUTD),'VAUTD I $P(DGJTNODE,"^",6)]"",'$D(VAUTD($P(DGJTNODE,"^",6))) Q
27 I $D(DGJTDV),$P(DGJTNODE,"^",6)]"" I $P(DGJTNODE,"^",6)'=+DGJTDV Q
28 I DGJTSR1=1,$P(DGJTNODE,"^",13)'=1 Q
29 I DGJTSR1=2,$P(DGJTNODE,"^",13)]"" Q
30 I DGJTSR1'=2 I $P(DGJTNODE,"^",2)=$O(^VAS(393.3,"B","DISCHARGE SUMMARY",0)) S X=$P(DGJTNODE,"^",4) I X]"" I $D(^DGPM(X,0)) S X=$P(^DGPM(X,0),"^",17) Q:X']""
31 S DGJTPC=$S(DGJTL="PAT":1,DGJTL="DAT":3,DGJTL="SER":8,DGJTL="PHY":14,1:"")
32 Q:$P(DGJTNODE,"^",2)']"" Q:'$D(^VAS(393.3,$P(DGJTNODE,"^",2),0)) I "^OP REPORT^DISCHARGE SUMMARY^INTERIM SUMMARY^"'[$P(^VAS(393.3,$P(DGJTNODE,"^",2),0),"^",1) Q
33 I $D(VAUTN),'VAUTN I '$D(VAUTN(+$P(DGJTNODE,"^",DGJTPC))) Q
34 I $D(VAUTT),'VAUTT I '$D(VAUTT(+$P(DGJTNODE,"^",7))) Q
35 I $D(VAUTY),'VAUTY I '$D(VAUTY(+$P(DGJTNODE,"^",2))) Q
36 I $P(DGJTNODE,"^",3)<DGJTBG!($P(DGJTNODE,"^",3)>DGJTEND) Q
37 D ^DGJTUDIS I 'DGJTFLAG Q
38 S DGJTDIV=$P(DGJTNODE,"^",6),DGJTDVN=$S(DGJTDIV]"":DGJTDIV,1:$O(^DG(40.8,0))),DGJTDVN=$S($D(^DG(40.8,+DGJTDVN,0)):$P(^(0),"^",1),1:"NOT SPECIFIED") I '$D(DGJTOT(DGJTDVN)) S DGJTOT(DGJTDVN)=0
39 S DFN=$P(DGJTNODE,"^",1) I $D(^DPT(DFN,0)) S DGJTPT=$P(^(0),"^",1)
40 I DGJTL="PAT" S ^UTILITY("VAS",$J,DGJTDVN,DGJTPT,DFN,IFN)=DGJTDL D CNT Q
41 I DGJTL="DAT" S DGJTDT=$P(DGJTNODE,"^",DGJTPC) S ^UTILITY("VAS",$J,DGJTDVN,DGJTDT,DGJTPT,DFN,IFN)=DGJTDL D CNT Q
42 I DGJTL="PHY" S DGJTPHY=$S($P(DGJTNODE,"^",DGJTPC)]""&($D(^VA(200,+$P(DGJTNODE,"^",DGJTPC),0))):$P(^(0),"^",1),1:"NOT SPECIFIED") S ^UTILITY("VAS",$J,DGJTDVN,DGJTPHY,DGJTPT,DFN,IFN)=DGJTDL D CNT Q
43 I DGJTL="SER" S DGJTSV=$S($P(DGJTNODE,"^",DGJTPC)]""&($D(^DG(393.1,+$P(DGJTNODE,"^",DGJTPC),0))):$P(^(0),"^",1),1:"NOT SPECIFIED"),DGJTSP=$S($P(DGJTNODE,"^",7)]""&($D(^DIC(45.7,+$P(DGJTNODE,"^",7),0))):$P(^(0),"^",1),1:"NOT SPECIFIED")
44 I DGJTL="SER" S X=DGJTDVN,DGJTDVN=$E(DGJTDVN,1,23),DGJTSV=$E(DGJTSV,1,16),DGJTPT=$E(DGJTPT,1,16),DGJTSP=$E(DGJTSP,1,16) S ^UTILITY("VAS",$J,DGJTDVN,DGJTSV,DGJTSP,DGJTPT,DFN,IFN)=DGJTDL D CNT Q
45 Q
46PAT S VAUTNI=2 D PATIENT^VAUTOMA
47 Q
48PHY S VAUTVB="VAUTN",DIC="^VA(200,",VAUTSTR="Physician",VAUTNI=2 D FIRST^VAUTOMA S:Y=-1 DGJFL=1 Q:DGJFL
49 Q
50DAT ;DATE RANGE
51BEG W ! S %DT="AEX",%DT("A")="START WITH EVENT DATE: " D ^%DT S DGJTBG=Y,DGJTBEG=Y-.0001 S:X="^"!(X="") Y=-1 Q:Y=-1
52END W ! S %DT("A")="END WITH EVENT DATE: " D ^%DT S:X="^"!(X="") Y=-1 Q:Y=-1 I Y<1 D HELP^%DTC G END
53 S DGJTEND=Y_.9999
54 I DGJTEND\1<DGJTBG W !!?5,"The ending date cannot be before the beginning date" G END
55 Q
56SER S VAUTVB="VAUTN",DIC="^DG(393.1,",VAUTSTR="Service",VAUTNI=2 D FIRST^VAUTOMA Q:Y=-1
57 S VAUTVB="VAUTT",DIC="^DIC(45.7,",VAUTSTR="Specialty",VAUTNI=2 D FIRST^VAUTOMA
58 Q
59RECTYP(DGJTNODE) ; Get Default record type for Medical records.
60 ; input variables
61 ; DGJTNODE := IRT node string
62 ;
63 ; output variables
64 ; Default Record Type for Medical records, 1 if null (MEDICAL RECORD)
65 ;
66 N X
67 ; check Division / get Division
68 I $P(DGJTNODE,"^",6)']"" Q 1
69 S X=$P(DGJTNODE,"^",6)
70 S X=$P(^DG(40.8,X,"DT"),"^",12)
71 S:X="" X=1
72 Q +X
Note: See TracBrowser for help on using the repository browser.