source: FOIAVistA/trunk/r/INCOMPLETE_RECORDS_TRACKING-DGJ/DGJPDEF2.m@ 897

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

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1DGJPDEF2 ;ALB/MAF - PHYSICIAN DEFICIENCY PRINT ROUTINE (CONT) ; NOV 10 1992@300
2 ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
3 D HEAD F DGJ=0:0 S DGJTDV=$O(^TMP("VAS",$J,DGJTDV)) Q:DGJTDV']""!(DGU) S DGJTF=1 D @(DGJTL) Q:DGU
4 G:DGU QUIT I DGJTLPG'=1,$D(^TMP("VAS",$J)) D RET G:DGU QUIT D ^DGJPDEF3
5 F X=$Y:1:(IOSL-3) W !
6 D DIV
7QUIT G QUIT^DGJPDEF
8 F X=$Y:1:(IOSL-3) W ! D DIV
9HD1 W ?88,$J($P(DGJTDL,"^",2),7)
10 W ?97,$J($P(DGJTDL,"^",3),7)
11 W ?106,$J($P(DGJTDL,"^",4),7)
12 W ?116 S X=$P(DGJTDL,"^",2)+$P(DGJTDL,"^",3)+$P(DGJTDL,"^",4)+$P(DGJTDL,"^",1) W $J(X,7)
13 W ?128 S X=$S(X-30'>0:0,1:X-30) W $J(X,4)
14 Q
15SET S DGJTDV1=DGJTDV,DFN=DGJTDL Q
16DIV S X=$O(^DG(40.8,"B",DGJTDV1,0)) I $D(^DG(40.8,+X,"DT")) S DGJTDEL=^("DT") W $P(DGJTDEL,"^",9),! Q
17 Q
18DATE S DGJTX=$$FMTE^XLFDT(DGJTDT,"5DF"),DGJTX=$TR(DGJTX," ","0") W DGJTX K DGJTX Q
19DATE1 S X=$$FMTE^XLFDT(X,"5DF"),X=$TR(X," ","0") W X Q
20PHY D:'DGJTFF HDR
21 F DGJY=0:0 S DGJTPHY=$O(^TMP("VAS",$J,DGJTDV,DGJTPHY)) Q:DGJTPHY']""!(DGU) D:DGJTFF RET Q:DGU D:DGJTFF HEAD,HDR D HDR1 S DGJTFF=1 F DGJJ=0:0 S DGJTPT=$O(^TMP("VAS",$J,DGJTDV,DGJTPHY,DGJTPT)) Q:DGJTPT']""!(DGU) D PHY1 Q:DGU
22 Q
23PHY1 F DGJADM=-1:0 S DGJADM=$O(^TMP("VAS",$J,DGJTDV,DGJTPHY,DGJTPT,DGJADM)) Q:DGJADM']""!(DGU) F IFN=0:0 S IFN=$O(^TMP("VAS",$J,DGJTDV,DGJTPHY,DGJTPT,DGJADM,IFN)) Q:'IFN!(DGU) S DGJTDL=^(IFN) D SET I $D(^VAS(393,IFN,0)) D PRT2 Q:DGU
24 Q
25SER D:'DGJTFF HDR
26 F DGJY=0:0 S DGJTSV=$O(^TMP("VAS",$J,DGJTDV,DGJTSV)) Q:DGJTSV']""!(DGU) D:DGJTFF RET Q:DGU D:DGJTFF HEAD,HDR D HDR2 S DGJTFF=1 F DGJJ=0:0 S DGJTSP=$O(^TMP("VAS",$J,DGJTDV,DGJTSV,DGJTSP)) Q:DGJTSP']""!(DGU) D HDR3,SER1 Q:DGU
27 Q
28PAT D:'DGJTFF HDR
29 F DGJY=0:0 S DGJTPT=$O(^TMP("VAS",$J,DGJTDV,DGJTPT)) Q:DGJTPT']""!(DGU) D:DGJTFF RET Q:DGU D:DGJTFF HEAD,HDR D HDR4 S DGJTFF=1 F DGJADM=-1:0 S DGJADM=$O(^TMP("VAS",$J,DGJTDV,DGJTPT,DGJADM)) Q:DGJADM']""!(DGU) D PAT1 Q:DGU
30 Q
31PAT1 F DGJJ=0:0 S DGJTPHY=$O(^TMP("VAS",$J,DGJTDV,DGJTPT,DGJADM,DGJTPHY)) Q:DGJTPHY']""!(DGU) F IFN=0:0 S IFN=$O(^TMP("VAS",$J,DGJTDV,DGJTPT,DGJADM,DGJTPHY,IFN)) Q:'IFN!(DGU) S DGJTDL=^(IFN) D SET I $D(^VAS(393,IFN,0)) D PRT2 Q:DGU
32 Q
33SER1 F DGJP=0:0 S DGJTPT=$O(^TMP("VAS",$J,DGJTDV,DGJTSV,DGJTSP,DGJTPT)) Q:DGJTPT']""!(DGU) D SER2
34 Q
35SER2 F DFN=0:0 S DFN=$O(^TMP("VAS",$J,DGJTDV,DGJTSV,DGJTSP,DGJTPT,DFN)) Q:'DFN!(DGU) F IFN=0:0 S IFN=$O(^TMP("VAS",$J,DGJTDV,DGJTSV,DGJTSP,DGJTPT,DFN,IFN)) Q:'IFN!(DGU) S DGJTDL=^(IFN) D SET I $D(^VAS(393,IFN,0)) D PRT2 Q:DGU
36 Q
37PRT2 D RELP Q:DGU S DGJTNODE=^VAS(393,IFN,0)
38 I DGJTL="PAT" S X="",X=$S($P(DGJTPHY,"^",2)]"":$E($P($G(^VA(200,$P(DGJTPHY,"^",2),0)),"^",1),1,20),1:"NOT SPECIFIED") W !,$S(X]"":X,1:"NOT SPECIFIED")
39 I DGJTL="PHY" W !,$E($P(^DPT($P(DGJTPT,"^",2),0),"^",1),1,20)
40 I DGJTL="SER" W !,$E($P(^DPT($P(DGJTPT,"^",2),0),"^",1),1,16)
41 D PID^VADPT6 W:DGJTL="SER" ?19 W:DGJTL'="SER" ?23 W VA("BID")
42 S DGJTDT=$S($D(^DGPM(+$P(DGJTNODE,"^",4),0)):$P(^DGPM(+$P(DGJTNODE,"^",4),0),"^",1),1:"OUTPATIENT") W:DGJTL="SER" ?27 W:DGJTL'="SER" ?31 D:DGJTDT]""&(DGJTDT'="OUTPATIENT") DATE I DGJTDT="OUTPATIENT" W DGJTDT
43 W:DGJTL="SER" ?40 W:DGJTL'="SER" ?44 S X=$P(^VAS(393,IFN,0),"^",2) W $S($D(^VAS(393.3,+X,0)):$E($P(^VAS(393.3,+X,0),"^",1),1,10),1:"NOT SPECIF")
44 S X=$P(^VAS(393,IFN,0),"^",12),X=$S(X]""&($D(^VA(200,+X,0))):$P(^VA(200,X,0),"^",1),1:"NOT SPECIFIED") W:DGJTL="SER" ?57,$E(X,1,10)
45 S X=IFN I X]"",$D(^VAS(393,+X,0)) S X=$P(^VAS(393,+X,0),"^",3) W ?70 S X=$$FMTE^XLFDT(X,"5DF") S:X]"" X=$TR(X," ","0") W X
46 W ?82 S X=$P(DGJTNODE,"^",11) W $S($D(^DG(393.2,+X,0)):$E($P(^DG(393.2,X,0),"^",1),1,10),1:"")
47 S DFN=$P(DGJTNODE,"^",1) S RTE=DFN_";DPT(",RTYPE=$$RECTYP^DGJOPRT1(DGJTNODE) D LATEST^RTUTL3
48 W ?95,$E($P(RTDATA,"^",2),1,10),?107,$E($P(RTDATA,"^",3),1,10),?121 S X="" S X=$P(RTDATA,"^",4) D:RTDATA]"" DATE1 Q
49HEAD D HEAD^DGJPDEF3 Q
50RET F X=$Y:1:(IOSL-3) W !
51 D DIV Q:IOST'?1"C-".E
52 R ?22,"Enter <RET> to continue or ^ to QUIT ",X:DTIME S:X["^"!('$T) DGU=1 Q:DGU S DGFLAG=1 Q
53RELP I $Y+8>IOSL D RET:(IOST?1"C-".E) Q:DGU D HEAD
54 Q
55HDR W !?5,"DIVISION: ",$S($D(^DG(40.8,+$P(DGJTDV,"^",2),0)):$P(^DG(40.8,$P(DGJTDV,"^",2),0),"^",1),1:"NOT SPECIFIED") Q
56HDR1 W !?6,"PHYSICIAN: ",$S($P(DGJTPHY,"^",2)]""&($D(^VA(200,+$P(DGJTPHY,"^",2),0))):$P(^VA(200,$P(DGJTPHY,"^",2),0),"^",1),1:"NOT SPECIFIED") Q
57HDR2 W !?6,"SERVICE: ",$S($P(DGJTSV,"^",2)]"":$P(^DG(393.1,$P(DGJTSV,"^",2),0),"^",1),1:"NOT SPECIFIED") Q
58HDR3 W !?7,"SPECIALTY: ",$S($P(DGJTSP,"^",2)]"":$P(^DIC(45.7,$P(DGJTSP,"^",2),0),"^",1),1:"NOT SPECIFIED") Q
59HDR4 W !?6,"PATIENT: ",$P(^DPT($P(DGJTPT,"^",2),0),"^",1) Q
60SV D SV^DGJPDEF3 Q
Note: See TracBrowser for help on using the repository browser.