source: WorldVistAEHR/trunk/r/INCOMPLETE_RECORDS_TRACKING-DGJ/DGJPDEF1.m@ 1110

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

initial load of WorldVistAEHR

File size: 4.8 KB
Line 
1DGJPDEF1 ;ALB/MAF - PHYSICIAN DEFICIENCY PRINT ROUTINE (CONT) ; NOV 10 1992@300
2 ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
3 ;;MAS VERSION 5.2;
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 D DAT^DGJPDEF G:Y=-1 QUIT
8 S VAUTVB="VAUTY",DIC="^VAS(393.3,",VAUTSTR="Deficiency",VAUTNI=2 D FIRST^VAUTOMA G QUIT:Y=-1
9 D ASK1^DGJPDEF G:Y=-1 QUIT
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="DGJDSC^DGJTDV^DGJTDIR^DGJTDAT^DGJTLPG^DGJTSTAT^DGJTCK^DGJTFL^DGJTMESS^DGJTSR^DGJTSR1^DGJTMUL^DGJTL^DGJTBG^DGJTEND^VAUTD#^VAUTN#^VAUTT#^VAUTY#",DGPGM="START^DGJPDEF1" D ZIS^DGJUTQ I 'POP U IO G START^DGJPDEF1
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 DGJTLPG=1!(DGJTLPG=3),$D(^TMP("VAS",$J)) S (DGJ,DGJTF,DGJTFF,DGJY,DGJTDV,DGJTDT,DGJTSV,DGJTSP,DGJTPHY,DGJTPT,DGU,DFN,IFN)=0,$P(DGJTLN,"=",133)="" G ^DGJPDEF2
16 I DGJTLPG=2,$D(^TMP("VAS",$J)) S (DGJ,DGJTF,DGJTFF,DGJY,DGJTDV,DGJTDT,DGJTSV,DGJTSP,DGJTPHY,DGJTPT,DGU,DFN,IFN)=0,$P(DGJTLN,"=",133)="" G ^DGJPDEF3
17 I '$D(^TMP("VAS",$J)) W !!,"NO RECORDS"
18QUIT G QUIT^DGJPDEF
19SSP ;find service and specialty
20 N CA S (DGJT,CA)=$S($P(DGJTNODE,"^",2)]"":+$P(DGJTNODE,"^",2),1:"") Q:DGJT']""
21 S:'$D(^DGPM(+DGJT,0)) DGJTQF=1 Q:'$D(^DGPM(+DGJT,0)) S DGJT=$O(^DGPM("ATS",DFN,DGJT,0)) S DGJT=$O(^(+DGJT,0)),DGJT=$O(^(+DGJT,0)),DGJT=$S($D(^DGPM(+DGJT,0)):^(0),1:"")
22 D WARD^DGJTUTL
23 I +X S DGJTWARD=+X,X=$S($D(^DIC(42,+X,0)):$P(^(0),"^",11),1:""),DGJTDIV=X
24 S DGJTP=$S($D(^DG(40.8,+DGJTDIV,"DT")):^("DT"),1:"")
25 S DGJTSV=$S(DGJTWARD]"":$P(^DIC(42,+DGJTWARD,0),"^",3),1:"") I DGJTSV]"" S DGJTSV=$O(^DG(393.1,"AC",DGJTSV,0)) S:(VAUTN=0)&('$D(VAUTN(DGJTSV))) DGJTQF=1 Q:DGJTQF S DGJTSV=$S($D(^DG(393.1,+DGJTSV,0)):$P(^DG(393.1,+DGJTSV,0),"^",1),1:"NONE")
26 I DGJTSV']"" S:DGJTSV']"" DGJTSV=0 S DGJTSV=$S($D(^DG(393.1,"AC",DGJTSV)):$O(^(DGJTSV,0)),1:"") I DGJTSV']"" S DGJTSV=$O(^DG(393.1,"AC",0,0))
27 S DGJTSP=$P(DGJT,"^",9) S:VAUTT=0&('$D(VAUTT(+DGJTSP))) DGJTQF=1 Q:DGJTQF S DGJTSP=$S($D(^DIC(45.7,+DGJTSP,0)):$P(^DIC(45.7,DGJTSP,0),"^",1),1:"NOT SPECIFIED")
28 Q
29CK S DGJTQF=0 I $D(VAUTD),'VAUTD Q:$P(DGJTNODE,"^",6)']"" I '$D(VAUTD(+$P(DGJTNODE,"^",6))) Q
30 I $D(DGJTDV),$P(DGJTNODE,"^",6)]"" I $P(DGJTNODE,"^",6)'=DGJTDV Q
31 S X=$P(DGJTNODE,"^",6),X1=$G(^DG(40.8,+X,"DT")),X1=$P(X1,"^",3),X2=$P(DGJTNODE,"^",11) I X1=0&(X2=$O(^DG(393.2,"B","SIGNED NO REVIEW",0))) K X1,X2,X3 Q
32 I X1=1&(X2=$O(^DG(393.2,"B","REVIEWED",0))) K X1,X2,X3 Q
33 I X2=$O(^DG(393.2,"B","COMPLETED",0)) K X1,X2,X3 Q
34 K X1,X2,X3
35 I DGJTSR1=1,$P(DGJTNODE,"^",4)']"" Q
36 I DGJTSR1=2,$P(DGJTNODE,"^",4)]"" Q
37 I $D(VAUTY),'VAUTY I '$D(VAUTY(+$P(DGJTNODE,"^",2))) Q
38 I $P(DGJTNODE,"^",3)<DGJTBG!($P(DGJTNODE,"^",3)>DGJTEND) Q
39 I DGJTL="PHY",$D(VAUTN),'VAUTN I '$D(VAUTN(+$P(DGJTNODE,"^",14))) Q
40 I DGJTL="PAT",$D(VAUTN),'VAUTN S X=$P(DGJTNODE,"^",1) I '$D(VAUTN(+X)) Q
41 I DGJDSC,DGJTSR1'=2 S X=$P(DGJTNODE,"^",4) I X]"" I $D(^DGPM(X,0)) S X=$P(^DGPM(X,0),"^",17) I X']"" S X=$P(DGJTNODE,"^",2),X=$G(^VAS(393.3,+X,0)) I X]"" S X=$P(X,"^",6) I X=$O(^VAS(393.41,"B","SUMMARY",0)) Q
42 S DGJTDIV=$P(DGJTNODE,"^",6),DGJTDVN=$E($S($P(DGJTNODE,"^",6)]""&($D(^DG(40.8,+$P(DGJTNODE,"^",6),0))):$P(^(0),"^",1),1:"NOT SPECIFIED"),1,10)_"^"_$P(DGJTNODE,"^",6) I '$D(DGJTOT(DGJTDVN)) S DGJTOT(DGJTDVN)=0
43 S DFN=+DGJTNODE S DGJTPT=$E($S('$D(^DPT(+DFN,0)):"UNDEFINED",1:$P(^DPT(+DFN,0),"^",1)),1,10)_"^"_DFN
44 I DGJTL="PHY" S DGJTPHY=$E($S($P(DGJTNODE,"^",14)]""&($D(^VA(200,+$P(DGJTNODE,"^",14),0))):$P(^(0),"^",1),1:"NOT SPECIFIED"),1,10)_"^"_$P(DGJTNODE,"^",14) S ^TMP("VAS",$J,DGJTDVN,DGJTPHY,DGJTPT,+$P(DGJTNODE,"^",4),IFN)=DFN Q
45 I DGJTL="PAT" S DGJTPHY=$E($S($P(DGJTNODE,"^",14)]""&($D(^VA(200,+$P(DGJTNODE,"^",14),0))):$P(^(0),"^",1),1:"NOT SPECIFIED"),1,10)_"^"_$P(DGJTNODE,"^",14) S ^TMP("VAS",$J,DGJTDVN,DGJTPT,+$P(DGJTNODE,"^",4),DGJTPHY,IFN)=DFN Q
46 I DGJTL="SER" S X=$P(DGJTNODE,"^",8) S DGJTSV=$S(X]""&($D(^DG(393.1,+$P(DGJTNODE,"^",8),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")
47 S X=$P(DGJTNODE,"^",8) I X]"" Q:VAUTN=0&('$D(VAUTN(+X))) S DGJTSV=$E($S(X]""&($D(^DG(393.1,+X,0))):$P(^(0),"^",1),1:"NOT SPECIFIED"),1,10)_"^"_+X
48 S X=$P(DGJTNODE,"^",7) I X]"" Q:VAUTT=0&('$D(VAUTT(+X))) S DGJTSP=$E($S(X]""&($D(^DIC(45.7,+X,0))):$P(^(0),"^",1),1:"NOT SPECIFIED"),1,10)_"^"_+X
49 Q:DGJTQF
50 I DGJTL="SER" S ^TMP("VAS",$J,DGJTDVN,DGJTSV,DGJTSP,DGJTPT,DFN,IFN)=DFN Q
51 Q
52PHY S VAUTVB="VAUTN",DIC="^VA(200,",VAUTSTR="Physician",VAUTNI=2 D FIRST^VAUTOMA S:Y=-1 DGJFL=1 Q:DGJFL
53 Q
54PAT S VAUTNI=2 D PATIENT^VAUTOMA
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
Note: See TracBrowser for help on using the repository browser.