DGJOPRT3 ;ALB/MAF - TOTALS PAGE FOR REPORTS ; SEP 26 1991@1100
;;1.0;Incomplete Records Tracking;;Jun 25, 2001
;
D HEAD1 S DGJTOTAL=0 F DGJTTO=0:0 S DGJTOTAL=$O(DGJTOT(DGJTOTAL)) Q:DGJTOTAL']"" W !,DGJTOTAL,?40,$J(DGJTOT(DGJTOTAL),4)
Q
HEAD1 W @IOF,"TOTALS PAGE BY DIVISION",!,"DIVISION",?37,"TOTAL DELINQ",!,DGJTLN Q
RET1 F X=$Y:1:(IOSL-3) W !
S X=$O(^DG(40.8,"B",DGJTDV1,0)) I $D(^DG(40.8,+X,"DT")) S DGJTDEL=^("DT") W $P(DGJTDEL,"^",9),!
Q:IOST'?1"C-".E
R ?22,"Enter <RET> to continue or ^ to QUIT ",X:DTIME S:X["^"!('$T) DGU=1 Q:DGU S DGFLAG=1 Q
HEAD S:DGJTDV'=DGJTDV1 DGJTPAG=0
W @IOF,$S(DGJTDIR=1:"UNDICTATED ",1:"INCOMPLETE ")_"RECORDS LISTING BY "_$S(DGJTL="DAT":"EVENT DATE",DGJTL="PAT":"PATIENT",DGJTL="PHY":"PHYSICIAN",1:"SERVICE/SPECIALTY"),?99,DGJTDAT," ","PAGE " S DGJTPAG=DGJTPAG+1 W DGJTPAG
I DGJTL="DAT" W !,"EVT DATE",?11,"PATIENT",?28,"PT ID"
I DGJTL'="DAT" W !,"PATIENT",?18,"PT ID",?26,"EVT DATE"
W ?39,"D/C TYPE",?53,"LOCATION",?69,"BORROWER"
I DGJTL'="PHY" W ?87,"PHYSICIAN",?106,"TYP" W:DGJTDIR=2 ?112,"STATUS" W ?120,"TOTAL DAYS",!,DGJTLN,!
I DGJTL="PHY" W ?87,"TYP" W:DGJTDIR=2 ?94,"STATUS" W ?110,"TOTAL DAYS",!,DGJTLN,!
Q
QUIT K DFN,DGJTBEG,DGJTBG,DGJTEND,DGJFL,DGJTDT,DGJTDV,DGJTDVN,DGJTF,DGJTFF,DGJTFLAG,DGJ,DGJJ,DGJP,DGJSPTOT,DGJSVTOT,DGJTLN,DGJTL,DGJTMUL,DGJTNODE,DGJTPC,DGJTPHY,DGJTPT,DGJTSP,DGJTSV,DGJY,DGU,DIC,IFN,VAUTD,VAUTN,VAUTNI,VAUTSTR,VAUTVB,VAUTT,X,Y
K %,DIR,DGFLAG,DGJTAD,DGJTCK,DGJTDAT,DGJTDEL,DGJTDIR,DGJTDIS,DGJTDIV,DGJTDL,DGJTDV1,DGJTMESS,DGJTNODT,DGJTNOW,DGJTOT,DGJTOTAL,DGJTPAG,DGJTPAR,DGJPHTOT,DGJTSR,DGJTSR1,DGJTSTAT,DGJTTO,DGJTTYP,DGPGM,DGVAR,POP,VAR,VA,VADAT,VADATE,VAERR
K RT,RTDATA,RTE,RTYPE,VAUTY,^UTILITY("VAS",$J)
D CLOSE^DGJUTQ Q
PH Q:$O(^UTILITY("VAS",$J,DGJTDV,DGJTPHY,DGJTPT))]"" Q:$O(^UTILITY("VAS",$J,DGJTDV,DGJTPHY,DGJTPT,DFN,IFN))]"" W !,"------------------------",!,"COUNT: ",DGJPHTOT(DGJTDV,DGJTPHY) D RET1:(IOST'?1"C-".E) Q
SV Q:$O(^UTILITY("VAS",$J,DGJTDV,DGJTSV,DGJTSP,DGJTPT))]"" Q:$O(^UTILITY("VAS",$J,DGJTDV,DGJTSV,DGJTSP,DGJTPT,DFN,IFN))]"" W !,"------------------------",!,"COUNT: ",DGJSPTOT(DGJTDV,DGJTSV,DGJTSP)
Q:$O(^UTILITY("VAS",$J,DGJTDV,DGJTSV,DGJTSP))]"" W !,"------------------------",!,"SERVICE SUBTOTAL: ",DGJSVTOT(DGJTDV,DGJTSV),! D RET1:(IOST'?1"C-".E) Q
Q
HD1 W ?87,$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:"")
I DGJTDIR=2 W ?94,$S($P(DGJTNODE,"^",11)&($D(^DG(393.2,+$P(DGJTNODE,"^",11),0))):$E($P(^DG(393.2,$P(DGJTNODE,"^",11),0),"^",1),1,10),1:"")
W ?110,$J(DGJTDL,4)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGJOPRT3 2599 printed Dec 13, 2024@02:00:36 Page 2
DGJOPRT3 ;ALB/MAF - TOTALS PAGE FOR REPORTS ; SEP 26 1991@1100
+1 ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
+2 ;
+3 DO HEAD1
SET DGJTOTAL=0
FOR DGJTTO=0:0
SET DGJTOTAL=$ORDER(DGJTOT(DGJTOTAL))
if DGJTOTAL']""
QUIT
WRITE !,DGJTOTAL,?40,$JUSTIFY(DGJTOT(DGJTOTAL),4)
+4 QUIT
HEAD1 WRITE @IOF,"TOTALS PAGE BY DIVISION",!,"DIVISION",?37,"TOTAL DELINQ",!,DGJTLN
QUIT
RET1 FOR X=$Y:1:(IOSL-3)
WRITE !
+1 SET X=$ORDER(^DG(40.8,"B",DGJTDV1,0))
IF $DATA(^DG(40.8,+X,"DT"))
SET DGJTDEL=^("DT")
WRITE $PIECE(DGJTDEL,"^",9),!
+2 if IOST'?1"C-".E
QUIT
+3 READ ?22,"Enter <RET> to continue or ^ to QUIT ",X:DTIME
if X["^"!('$TEST)
SET DGU=1
if DGU
QUIT
SET DGFLAG=1
QUIT
HEAD if DGJTDV'=DGJTDV1
SET DGJTPAG=0
+1 WRITE @IOF,$SELECT(DGJTDIR=1:"UNDICTATED ",1:"INCOMPLETE ")_"RECORDS LISTING BY "_$SELECT(DGJTL="DAT":"EVENT DATE",DGJTL="PAT":"PATIENT",DGJTL="PHY":"PHYSICIAN",1:"SERVICE/SPECIALTY"),?99,DGJTDAT," ","PAGE "
SET DGJTPAG=DGJTPAG+1
WRITE DGJTPAG
+2 IF DGJTL="DAT"
WRITE !,"EVT DATE",?11,"PATIENT",?28,"PT ID"
+3 IF DGJTL'="DAT"
WRITE !,"PATIENT",?18,"PT ID",?26,"EVT DATE"
+4 WRITE ?39,"D/C TYPE",?53,"LOCATION",?69,"BORROWER"
+5 IF DGJTL'="PHY"
WRITE ?87,"PHYSICIAN",?106,"TYP"
if DGJTDIR=2
WRITE ?112,"STATUS"
WRITE ?120,"TOTAL DAYS",!,DGJTLN,!
+6 IF DGJTL="PHY"
WRITE ?87,"TYP"
if DGJTDIR=2
WRITE ?94,"STATUS"
WRITE ?110,"TOTAL DAYS",!,DGJTLN,!
+7 QUIT
QUIT KILL DFN,DGJTBEG,DGJTBG,DGJTEND,DGJFL,DGJTDT,DGJTDV,DGJTDVN,DGJTF,DGJTFF,DGJTFLAG,DGJ,DGJJ,DGJP,DGJSPTOT,DGJSVTOT,DGJTLN,DGJTL,DGJTMUL,DGJTNODE,DGJTPC,DGJTPHY,DGJTPT,DGJTSP,DGJTSV,DGJY,DGU,DIC,IFN,VAUTD,VAUTN,VAUTNI,VAUTSTR,VAUTVB,VAUTT,X,Y
+1 KILL %,DIR,DGFLAG,DGJTAD,DGJTCK,DGJTDAT,DGJTDEL,DGJTDIR,DGJTDIS,DGJTDIV,DGJTDL,DGJTDV1,DGJTMESS,DGJTNODT,DGJTNOW,DGJTOT,DGJTOTAL,DGJTPAG,DGJTPAR,DGJPHTOT,DGJTSR,DGJTSR1,DGJTSTAT,DGJTTO,DGJTTYP,DGPGM,DGVAR,POP,VAR,VA,VADAT,VADATE,VAERR
+2 KILL RT,RTDATA,RTE,RTYPE,VAUTY,^UTILITY("VAS",$JOB)
+3 DO CLOSE^DGJUTQ
QUIT
PH if $ORDER(^UTILITY("VAS",$JOB,DGJTDV,DGJTPHY,DGJTPT))]""
QUIT
if $ORDER(^UTILITY("VAS",$JOB,DGJTDV,DGJTPHY,DGJTPT,DFN,IFN))]""
QUIT
WRITE !,"------------------------",!,"COUNT: ",DGJPHTOT(DGJTDV,DGJTPHY)
if (IOST'?1"C-".E)
DO RET1
QUIT
SV if $ORDER(^UTILITY("VAS",$JOB,DGJTDV,DGJTSV,DGJTSP,DGJTPT))]""
QUIT
if $ORDER(^UTILITY("VAS",$JOB,DGJTDV,DGJTSV,DGJTSP,DGJTPT,DFN,IFN))]""
QUIT
WRITE !,"------------------------",!,"COUNT: ",DGJSPTOT(DGJTDV,DGJTSV,DGJTSP)
+1 if $ORDER(^UTILITY("VAS",$JOB,DGJTDV,DGJTSV,DGJTSP))]""
QUIT
WRITE !,"------------------------",!,"SERVICE SUBTOTAL: ",DGJSVTOT(DGJTDV,DGJTSV),!
if (IOST'?1"C-".E)
DO RET1
QUIT
+2 QUIT
HD1 WRITE ?87,$SELECT($PIECE(DGJTNODE,"^",2)]""&($DATA(^VAS(393.3,+$PIECE(DGJTNODE,"^",2),0))):$EXTRACT($PIECE(^VAS(393.3,$PIECE(DGJTNODE,"^",2),0),"^",1),1,3),1:"")
+1 IF DGJTDIR=2
WRITE ?94,$SELECT($PIECE(DGJTNODE,"^",11)&($DATA(^DG(393.2,+$PIECE(DGJTNODE,"^",11),0))):$EXTRACT($PIECE(^DG(393.2,$PIECE(DGJTNODE,"^",11),0),"^",1),1,10),1:"")
+2 WRITE ?110,$JUSTIFY(DGJTDL,4)
+3 QUIT
