| 1 | DGJOTP2 ;ALB/MAF - TRANS PROD REPORT CONT. 2 ; AUG 30 1991@1000
|
|---|
| 2 | ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
|
|---|
| 3 | ;
|
|---|
| 4 | D HEAD F DGJ=0:0 S DGJTDV=$O(^UTILITY("VAS",$J,DGJTDV)) Q:DGJTDV']""!(DGU) S DGJTF=1 D @(DGJTL) Q:DGU
|
|---|
| 5 | G:DGU QUIT I DGJTLPG'=1,$D(^UTILITY("VAS",$J)) D RET G:DGU QUIT D ^DGJOTP3
|
|---|
| 6 | QUIT G QUIT^DGJOTP
|
|---|
| 7 | HD1 W ?65,$S($P(DGJTNODE,"^",2)]""&($D(^VAS(393.3,+$P(DGJTNODE,"^",2),0))):$E($P(^VAS(393.3,$P(DGJTNODE,"^",2),0),"^",1),1,3),1:"")
|
|---|
| 8 | I DGJTDIR=2 W ?70 S X=$P(DGJTNODE,"^",11) W $S(X=1:"UNDICT",X=2:"DICTAT",X=3:"TRANSC",X=4:"SIGNED",1:"")
|
|---|
| 9 | S X=$S('$D(^VAS(393,IFN,"DT")):"",$P(^("DT"),"^",1)]"":$P(^("DT"),"^",1),1:"")
|
|---|
| 10 | W ?77 S:X]"" X=$$FMTE^XLFDT(X,"5DF"),X=$TR(X," ","0") W X
|
|---|
| 11 | W ?88,$J($P(DGJTDL,"^",2),7)
|
|---|
| 12 | W ?97,$J($P(DGJTDL,"^",3),7)
|
|---|
| 13 | W ?106,$J($P(DGJTDL,"^",4),7)
|
|---|
| 14 | W ?116 S X=$P(DGJTDL,"^",2)+$P(DGJTDL,"^",3)+$P(DGJTDL,"^",4) W $J(X,7) S DGJDYAVG=DGJDYAVG+X
|
|---|
| 15 | W ?128 S X=$S(X-30'>0:0,1:X-30) W $J(X,4) S DGJ30AVG=DGJ30AVG+X
|
|---|
| 16 | Q
|
|---|
| 17 | SET S DGJTDV1=DGJTDV Q
|
|---|
| 18 | DIV W "* PENDING STATUS - Number of days pending",! Q
|
|---|
| 19 | Q
|
|---|
| 20 | DATE S DGJTX=$$FMTE^XLFDT(DGJTDT,"5DF"),DGJTX=$TR(DGJTX," ","0") W DGJTX K DGJTX Q
|
|---|
| 21 | PHY D:'DGJTFF HDR
|
|---|
| 22 | F DGJY=0:0 S DGJTPHY=$O(^UTILITY("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(^UTILITY("VAS",$J,DGJTDV,DGJTPHY,DGJTPT)) Q:DGJTPT']""!(DGU) D PHY1 Q:DGU
|
|---|
| 23 | Q
|
|---|
| 24 | PHY1 F DFN=0:0 S DFN=$O(^UTILITY("VAS",$J,DGJTDV,DGJTPHY,DGJTPT,DFN)) Q:'DFN!(DGU) F IFN=0:0 S IFN=$O(^UTILITY("VAS",$J,DGJTDV,DGJTPHY,DGJTPT,DFN,IFN)) Q:'IFN!(DGU) S DGJTDL=^(IFN) D SET I $D(^VAS(393,IFN,0)) D PRT2 Q:DGU D PH^DGJOTP3
|
|---|
| 25 | Q
|
|---|
| 26 | SER D:'DGJTFF HDR
|
|---|
| 27 | F DGJY=0:0 S DGJTSV=$O(^UTILITY("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(^UTILITY("VAS",$J,DGJTDV,DGJTSV,DGJTSP)) Q:DGJTSP']""!(DGU) D HDR3,SER1 Q:DGU
|
|---|
| 28 | Q
|
|---|
| 29 | SER1 F DGJP=0:0 S DGJTPT=$O(^UTILITY("VAS",$J,DGJTDV,DGJTSV,DGJTSP,DGJTPT)) Q:DGJTPT']""!(DGU) D SER2
|
|---|
| 30 | Q
|
|---|
| 31 | SER2 F DFN=0:0 S DFN=$O(^UTILITY("VAS",$J,DGJTDV,DGJTSV,DGJTSP,DGJTPT,DFN)) Q:'DFN!(DGU) F IFN=0:0 S IFN=$O(^UTILITY("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 D SV
|
|---|
| 32 | Q
|
|---|
| 33 | PRT2 D RELP Q:DGU S DGJTNODE=^VAS(393,IFN,0)
|
|---|
| 34 | I DGJTL'="PHY" S DGJTPC=14 S DGJTPHY=$S($P(DGJTNODE,"^",DGJTPC)]""&($D(^VA(200,+$P(DGJTNODE,"^",DGJTPC),0))):$P(^(0),"^",1),1:"NOT SPECIFIED")
|
|---|
| 35 | I DGJTL="PHY" W !,$E(DGJTPT,1,20)
|
|---|
| 36 | I DGJTL="SER" W !,$E(DGJTPT,1,16)
|
|---|
| 37 | D PID^VADPT6 W:DGJTL="SER" ?19 W:DGJTL'="SER" ?23 W VA("BID")
|
|---|
| 38 | S DGJTDT=$P(DGJTNODE,"^",3) W:DGJTL="SER" ?26 W:DGJTL="PHY" ?31 D DATE
|
|---|
| 39 | W:DGJTL="SER" ?39 W:DGJTL="PHY" ?44 W $S($P(DGJTNODE,"^",5)]""&($D(^SC(+$P(DGJTNODE,"^",5),0))):$E($P(^SC($P(DGJTNODE,"^",5),0),"^",1),1,12),1:"")
|
|---|
| 40 | W:DGJTL="SER" ?53,$E(DGJTPHY,1,10) D HD1 Q
|
|---|
| 41 | HEAD D HEAD^DGJOTP3 Q
|
|---|
| 42 | RET F X=$Y:1:(IOSL-3) W !
|
|---|
| 43 | D DIV Q:IOST'?1"C-".E
|
|---|
| 44 | R ?22,"Enter <RET> to continue or ^ to QUIT ",X:DTIME S:X["^"!('$T) DGU=1 Q:DGU S DGFLAG=1 Q
|
|---|
| 45 | RELP I $Y+8>IOSL D RET:(IOST?1"C-".E) Q:DGU D HEAD
|
|---|
| 46 | Q
|
|---|
| 47 | HDR W !?5,"DIVISION: ",DGJTDV Q
|
|---|
| 48 | HDR1 W !?6,"PHYSICIAN: ",DGJTPHY Q
|
|---|
| 49 | HDR2 W !?6,"SERVICE: ",DGJTSV Q
|
|---|
| 50 | HDR3 W !?7,"SPECIALTY: ",DGJTSP Q
|
|---|
| 51 | SV D SV^DGJOTP3 Q
|
|---|
