source: FOIAVistA/trunk/r/INCOMPLETE_RECORDS_TRACKING-DGJ/DGJPDEF1.m@ 1397

DGJPDEF1 ;ALB/MAF - PHYSICIAN DEFICIENCY PRINT ROUTINE (CONT) ; NOV 10 1992@300
 ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
 ;;MAS VERSION 5.2;
 I $D(DGJTMUL),DGJTMUL D DIVISION^VAUTOMA G:Y=-1 QUIT
 I 'DGJTMUL S DGJTDV=$O(^DG(40.8,0))
 D @(DGJTL) G:Y=-1 QUIT
 D DAT^DGJPDEF G:Y=-1 QUIT
 S VAUTVB="VAUTY",DIC="^VAS(393.3,",VAUTSTR="Deficiency",VAUTNI=2 D FIRST^VAUTOMA G QUIT:Y=-1
 D ASK1^DGJPDEF G:Y=-1 QUIT
 W !!,*7,"This output requires 132 column output",!
 D NOW^%DTC S Y=$E(%,1,12) S VADAT("W")=Y D ^VADATE S DGJTDAT=VADATE("E")
 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
 G QUIT
START S (DGJTPAG,DGJTDV1)=0 F IFN=0:0 S IFN=$O(^VAS(393,IFN)) Q:'IFN  S DGJTNODE=^VAS(393,IFN,0) D CK
 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
 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
 I '$D(^TMP("VAS",$J)) W !!,"NO RECORDS"
QUIT G QUIT^DGJPDEF
SSP ;find service and specialty
 N CA S (DGJT,CA)=$S($P(DGJTNODE,"^",2)]"":+$P(DGJTNODE,"^",2),1:"") Q:DGJT']""
 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:"")
 D WARD^DGJTUTL
 I +X S DGJTWARD=+X,X=$S($D(^DIC(42,+X,0)):$P(^(0),"^",11),1:""),DGJTDIV=X
 S DGJTP=$S($D(^DG(40.8,+DGJTDIV,"DT")):^("DT"),1:"")
 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")
 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))
 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")
 Q
CK S DGJTQF=0 I $D(VAUTD),'VAUTD Q:$P(DGJTNODE,"^",6)']""  I '$D(VAUTD(+$P(DGJTNODE,"^",6))) Q
 I $D(DGJTDV),$P(DGJTNODE,"^",6)]"" I $P(DGJTNODE,"^",6)'=DGJTDV Q
 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
 I X1=1&(X2=$O(^DG(393.2,"B","REVIEWED",0))) K X1,X2,X3 Q
 I X2=$O(^DG(393.2,"B","COMPLETED",0)) K X1,X2,X3 Q
 K X1,X2,X3
 I DGJTSR1=1,$P(DGJTNODE,"^",4)']"" Q
 I DGJTSR1=2,$P(DGJTNODE,"^",4)]"" Q
 I $D(VAUTY),'VAUTY I '$D(VAUTY(+$P(DGJTNODE,"^",2))) Q
 I $P(DGJTNODE,"^",3)<DGJTBG!($P(DGJTNODE,"^",3)>DGJTEND) Q
 I DGJTL="PHY",$D(VAUTN),'VAUTN I '$D(VAUTN(+$P(DGJTNODE,"^",14))) Q
 I DGJTL="PAT",$D(VAUTN),'VAUTN S X=$P(DGJTNODE,"^",1) I '$D(VAUTN(+X)) Q
 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
 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
 S DFN=+DGJTNODE S DGJTPT=$E($S('$D(^DPT(+DFN,0)):"UNDEFINED",1:$P(^DPT(+DFN,0),"^",1)),1,10)_"^"_DFN
 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
 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
 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")
 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
 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
 Q:DGJTQF
 I DGJTL="SER" S ^TMP("VAS",$J,DGJTDVN,DGJTSV,DGJTSP,DGJTPT,DFN,IFN)=DFN Q
 Q
PHY S VAUTVB="VAUTN",DIC="^VA(200,",VAUTSTR="Physician",VAUTNI=2 D FIRST^VAUTOMA S:Y=-1 DGJFL=1 Q:DGJFL
 Q
PAT S VAUTNI=2 D PATIENT^VAUTOMA
 Q
SER S VAUTVB="VAUTN",DIC="^DG(393.1,",VAUTSTR="Service",VAUTNI=2 D FIRST^VAUTOMA Q:Y=-1
 S VAUTVB="VAUTT",DIC="^DIC(45.7,",VAUTSTR="Specialty",VAUTNI=2 D FIRST^VAUTOMA
 Q