- DGJOTP3 ;ALB/MAF - TOTALS PAGE FOR TRANS PROD REPORT ; SEP 26 1991@1100
- ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
- ;
- S (DGJDOC,DGJTOTAL)=0
- F DGJTTO=0:0 S DGJTOTAL=$O(DGJTOT(DGJTOTAL)) Q:DGJTOTAL']""!(DGU) D SET,HEAD1,LIST,TOT
- QUIT G QUIT^DGJOTP
- SET S (DGJTDIC,DGJTTRN,DGJTCOD,DGJTTODY,DGJTO30,DGJTOREC)=0 Q
- TOT W !,"------------------------",?30,"-------",?45,"-------",?60,"-------",?75,"-------",?88,"-------",?100,"-------",?112,"-------",?125,"-------"
- W !,"DIVISION TOTAL",?30 S X=DGJTDIC/DGJTOREC D EXT W ?45 S X=DGJTTRN/DGJTOREC D EXT W ?60 S X=DGJTCOD/DGJTOREC D EXT W ?75 S X=DGJTTODY/DGJTOREC D EXT W ?88 S X=DGJTO30/DGJTOREC D EXT
- W ?100,$J(+DGJTOT(DGJTOTAL),7),?112,$S($P(DGJTOT(DGJTOTAL),"^",2)]"":$J($P(DGJTOT(DGJTOTAL),"^",2),7),1:$J(0,7)),?125 S X=($P(DGJTOT(DGJTOTAL),"^",2)/+DGJTOT(DGJTOTAL))*100 D EXT I $O(DGJTOT(DGJTOTAL))]"" D RET1 Q:DGU
- Q
- HEAD1 W @IOF,"TOTALS PAGE FOR "_DGJTOTAL,?100,DGJTDAT,!
- W $S(DGJTL="PHY":"PHYSICIAN",1:"SERVICE/SPECIALTY"),?30,"AVG DAYS",?45,"AVG DAYS",?60,"AVG DAYS",?75,"AVG TOT",?88,"AVG DAYS",?100,"TOT REC",?111,"REC DELQ",?123,"% DELQ>30",!
- W ?30,"D/C-DIC",?45,"DIC-TRAN",?60,"TRAN-COD",?75,"DAYS DELQ",?88,"DELQ>30",!,DGJTLN Q
- RET1 F X=$Y:1:(IOSL-3) W !
- 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
- RELP I $Y+8>IOSL D RET1:(IOST?1"C-".E) Q:DGU D HEAD:DGJTLPG=1 D HEAD1:DGJTLPG'=1
- Q
- HEAD S:DGJTDV'=DGJTDV1 DGJTPAG=0
- S DGJTDIR=2 W @IOF,"TRANSCRIPTION PRODUCTIVITY REPORT BY "_$S(DGJTL="PHY":"PHYSICIAN",1:"SERVICE/SPECIALTY"),?97,DGJTDAT," ","PAGE " S DGJTPAG=DGJTPAG+1 W DGJTPAG
- I DGJTL="SER" W !,"PATIENT",?19,"PT ID",?26,"EVT DATE",?39
- I DGJTL="PHY" W !,"PATIENT",?23,"PT ID",?31,"EVT DATE",?44
- W "LOCATION"
- I DGJTL="SER" W ?53,"PHYSICIAN"
- W ?65,"TYP" W:DGJTDIR=2 ?70,"STATUS"
- W ?78,"DIC DATE",?88,"D/C-DIC",?97,"DIC-TRN",?106,"TRN-COD",?115,"TOT DAYS",?125,"DELQ>30",!,DGJTLN,!
- Q
- PH Q:$O(^UTILITY("VAS",$J,DGJTDV,DGJTPHY,DGJTPT))]"" Q:$O(^UTILITY("VAS",$J,DGJTDV,DGJTPHY,DGJTPT,DFN,IFN))]""
- W !,"-------------------",?70,"-------",?88,"-------",?97,"-------",?106,"-------",?116,"-------",?125,"-------",!,"COUNT: ",$P(DGJPHTOT(DGJTDV,DGJTPHY),"^",1) D CNTWR 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 !,"------------------------",?70,"-------",?88,"-------",?97,"-------",?106,"-------",?116,"-------",?125,"-------",!,"SERVICE SUBTOTAL: ",$P(DGJSVTOT(DGJTDV,DGJTSV),"^",1) D CNTWR D RET1:(IOST'?1"C-".E) Q
- Q
- LIST F DGJTTI=0:0 S DGJDOC=$S(DGJTL="PHY":$O(DGJPHTOT(DGJTOTAL,DGJDOC)),1:$O(DGJSVTOT(DGJTOTAL,DGJDOC))) Q:DGJDOC']""!(DGU) D WR Q:DGU
- Q
- WR S DGJJX=0 W !,$E(DGJDOC,1,20),?30 S DGJX=$S(DGJTL="PHY":DGJPHTOT(DGJTOTAL,DGJDOC),1:DGJSVTOT(DGJTOTAL,DGJDOC)) S DGJJX=$P(DGJX,"^",1) S X=$P(DGJX,"^",3)/DGJJX D EXT W ?45 S X=$P(DGJX,"^",4)/DGJJX D EXT W ?60 S X=$P(DGJX,"^",5)/DGJJX D EXT
- W ?75 S X=$P(DGJX,"^",6)/DGJJX D EXT W ?88 S X=$P(DGJX,"^",7)/DGJJX D EXT
- W ?100,$J($P(DGJX,"^",1),7),?112 S X=$P(DGJX,"^",2) D EXT W ?125 S X=($P(DGJX,"^",2)/+DGJX)*100 D EXT D DIVTOT,RELP Q:DGU
- Q
- EXT S X=$S(X]"":X,1:0)
- I X["." S X=$P(X,".",1)_"."_$E($P(X,".",2),1,2) W $J(X,7) Q
- W $J(X,7) Q
- CNTWR W ?70,"AVG DAYS" S DGJCNTX=$S(DGJTL="PHY":DGJPHTOT(DGJTDV,DGJTPHY),1:DGJSVTOT(DGJTDV,DGJTSV)) S DGJ2CNT=$P(DGJCNTX,"^",1) W ?88 S X=$P(DGJCNTX,"^",3)/DGJ2CNT D EXT
- W ?97 S X=$P(DGJCNTX,"^",4)/DGJ2CNT D EXT W ?106 S X=$P(DGJCNTX,"^",5)/DGJ2CNT D EXT W ?116 S X=$P(DGJCNTX,"^",6)/DGJ2CNT D EXT W ?125 S X=$P(DGJCNTX,"^",7)/DGJ2CNT D EXT Q
- Q
- DIVTOT S DGJTDIC=DGJTDIC+$P(DGJX,"^",3),DGJTTRN=DGJTTRN+$P(DGJX,"^",4),DGJTCOD=DGJTCOD+$P(DGJX,"^",5),DGJTTODY=DGJTTODY+$P(DGJX,"^",6),DGJTO30=DGJTO30+$P(DGJX,"^",7),DGJTOREC=DGJTOREC+$P(DGJX,"^",1)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGJOTP3 3972 printed Jan 18, 2025@03:01:52 Page 2
- DGJOTP3 ;ALB/MAF - TOTALS PAGE FOR TRANS PROD REPORT ; SEP 26 1991@1100
- +1 ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
- +2 ;
- +3 SET (DGJDOC,DGJTOTAL)=0
- +4 FOR DGJTTO=0:0
- SET DGJTOTAL=$ORDER(DGJTOT(DGJTOTAL))
- if DGJTOTAL']""!(DGU)
- QUIT
- DO SET
- DO HEAD1
- DO LIST
- DO TOT
- QUIT GOTO QUIT^DGJOTP
- SET SET (DGJTDIC,DGJTTRN,DGJTCOD,DGJTTODY,DGJTO30,DGJTOREC)=0
- QUIT
- TOT WRITE !,"------------------------",?30,"-------",?45,"-------",?60,"-------",?75,"-------",?88,"-------",?100,"-------",?112,"-------",?125,"-------"
- +1 WRITE !,"DIVISION TOTAL",?30
- SET X=DGJTDIC/DGJTOREC
- DO EXT
- WRITE ?45
- SET X=DGJTTRN/DGJTOREC
- DO EXT
- WRITE ?60
- SET X=DGJTCOD/DGJTOREC
- DO EXT
- WRITE ?75
- SET X=DGJTTODY/DGJTOREC
- DO EXT
- WRITE ?88
- SET X=DGJTO30/DGJTOREC
- DO EXT
- +2 WRITE ?100,$JUSTIFY(+DGJTOT(DGJTOTAL),7),?112,$SELECT($PIECE(DGJTOT(DGJTOTAL),"^",2)]"":$JUSTIFY($PIECE(DGJTOT(DGJTOTAL),"^",2),7),1:$JUSTIFY(0,7)),?125
- SET X=($PIECE(DGJTOT(DGJTOTAL),"^",2)/+DGJTOT(DGJTOTAL))*100
- DO EXT
- IF $ORDER(DGJTOT(DGJTOTAL))]""
- DO RET1
- if DGU
- QUIT
- +3 QUIT
- HEAD1 WRITE @IOF,"TOTALS PAGE FOR "_DGJTOTAL,?100,DGJTDAT,!
- +1 WRITE $SELECT(DGJTL="PHY":"PHYSICIAN",1:"SERVICE/SPECIALTY"),?30,"AVG DAYS",?45,"AVG DAYS",?60,"AVG DAYS",?75,"AVG TOT",?88,"AVG DAYS",?100,"TOT REC",?111,"REC DELQ",?123,"% DELQ>30",!
- +2 WRITE ?30,"D/C-DIC",?45,"DIC-TRAN",?60,"TRAN-COD",?75,"DAYS DELQ",?88,"DELQ>30",!,DGJTLN
- QUIT
- RET1 FOR X=$Y:1:(IOSL-3)
- WRITE !
- +1 if IOST'?1"C-".E
- QUIT
- +2 READ ?22,"Enter <RET> to continue or ^ to QUIT ",X:DTIME
- if X["^"!('$TEST)
- SET DGU=1
- if DGU
- QUIT
- SET DGFLAG=1
- QUIT
- RELP IF $Y+8>IOSL
- if (IOST?1"C-".E)
- DO RET1
- if DGU
- QUIT
- if DGJTLPG=1
- DO HEAD
- if DGJTLPG'=1
- DO HEAD1
- +1 QUIT
- HEAD if DGJTDV'=DGJTDV1
- SET DGJTPAG=0
- +1 SET DGJTDIR=2
- WRITE @IOF,"TRANSCRIPTION PRODUCTIVITY REPORT BY "_$SELECT(DGJTL="PHY":"PHYSICIAN",1:"SERVICE/SPECIALTY"),?97,DGJTDAT," ","PAGE "
- SET DGJTPAG=DGJTPAG+1
- WRITE DGJTPAG
- +2 IF DGJTL="SER"
- WRITE !,"PATIENT",?19,"PT ID",?26,"EVT DATE",?39
- +3 IF DGJTL="PHY"
- WRITE !,"PATIENT",?23,"PT ID",?31,"EVT DATE",?44
- +4 WRITE "LOCATION"
- +5 IF DGJTL="SER"
- WRITE ?53,"PHYSICIAN"
- +6 WRITE ?65,"TYP"
- if DGJTDIR=2
- WRITE ?70,"STATUS"
- +7 WRITE ?78,"DIC DATE",?88,"D/C-DIC",?97,"DIC-TRN",?106,"TRN-COD",?115,"TOT DAYS",?125,"DELQ>30",!,DGJTLN,!
- +8 QUIT
- PH if $ORDER(^UTILITY("VAS",$JOB,DGJTDV,DGJTPHY,DGJTPT))]""
- QUIT
- if $ORDER(^UTILITY("VAS",$JOB,DGJTDV,DGJTPHY,DGJTPT,DFN,IFN))]""
- QUIT
- +1 WRITE !,"-------------------",?70,"-------",?88,"-------",?97,"-------",?106,"-------",?116,"-------",?125,"-------",!,"COUNT: ",$PIECE(DGJPHTOT(DGJTDV,DGJTPHY),"^",1)
- DO CNTWR
- 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
- +2 WRITE !,"------------------------",?70,"-------",?88,"-------",?97,"-------",?106,"-------",?116,"-------",?125,"-------",!,"SERVICE SUBTOTAL: ",$PIECE(DGJSVTOT(DGJTDV,DGJTSV),"^",1)
- DO CNTWR
- if (IOST'?1"C-".E)
- DO RET1
- QUIT
- +3 QUIT
- LIST FOR DGJTTI=0:0
- SET DGJDOC=$SELECT(DGJTL="PHY":$ORDER(DGJPHTOT(DGJTOTAL,DGJDOC)),1:$ORDER(DGJSVTOT(DGJTOTAL,DGJDOC)))
- if DGJDOC']""!(DGU)
- QUIT
- DO WR
- if DGU
- QUIT
- +1 QUIT
- WR SET DGJJX=0
- WRITE !,$EXTRACT(DGJDOC,1,20),?30
- SET DGJX=$SELECT(DGJTL="PHY":DGJPHTOT(DGJTOTAL,DGJDOC),1:DGJSVTOT(DGJTOTAL,DGJDOC))
- SET DGJJX=$PIECE(DGJX,"^",1)
- SET X=$PIECE(DGJX,"^",3)/DGJJX
- DO EXT
- WRITE ?45
- SET X=$PIECE(DGJX,"^",4)/DGJJX
- DO EXT
- WRITE ?60
- SET X=$PIECE(DGJX,"^",5)/DGJJX
- DO EXT
- +1 WRITE ?75
- SET X=$PIECE(DGJX,"^",6)/DGJJX
- DO EXT
- WRITE ?88
- SET X=$PIECE(DGJX,"^",7)/DGJJX
- DO EXT
- +2 WRITE ?100,$JUSTIFY($PIECE(DGJX,"^",1),7),?112
- SET X=$PIECE(DGJX,"^",2)
- DO EXT
- WRITE ?125
- SET X=($PIECE(DGJX,"^",2)/+DGJX)*100
- DO EXT
- DO DIVTOT
- DO RELP
- if DGU
- QUIT
- +3 QUIT
- EXT SET X=$SELECT(X]"":X,1:0)
- +1 IF X["."
- SET X=$PIECE(X,".",1)_"."_$EXTRACT($PIECE(X,".",2),1,2)
- WRITE $JUSTIFY(X,7)
- QUIT
- +2 WRITE $JUSTIFY(X,7)
- QUIT
- CNTWR WRITE ?70,"AVG DAYS"
- SET DGJCNTX=$SELECT(DGJTL="PHY":DGJPHTOT(DGJTDV,DGJTPHY),1:DGJSVTOT(DGJTDV,DGJTSV))
- SET DGJ2CNT=$PIECE(DGJCNTX,"^",1)
- WRITE ?88
- SET X=$PIECE(DGJCNTX,"^",3)/DGJ2CNT
- DO EXT
- +1 WRITE ?97
- SET X=$PIECE(DGJCNTX,"^",4)/DGJ2CNT
- DO EXT
- WRITE ?106
- SET X=$PIECE(DGJCNTX,"^",5)/DGJ2CNT
- DO EXT
- WRITE ?116
- SET X=$PIECE(DGJCNTX,"^",6)/DGJ2CNT
- DO EXT
- WRITE ?125
- SET X=$PIECE(DGJCNTX,"^",7)/DGJ2CNT
- DO EXT
- QUIT
- +2 QUIT
- DIVTOT SET DGJTDIC=DGJTDIC+$PIECE(DGJX,"^",3)
- SET DGJTTRN=DGJTTRN+$PIECE(DGJX,"^",4)
- SET DGJTCOD=DGJTCOD+$PIECE(DGJX,"^",5)
- SET DGJTTODY=DGJTTODY+$PIECE(DGJX,"^",6)
- SET DGJTO30=DGJTO30+$PIECE(DGJX,"^",7)
- SET DGJTOREC=DGJTOREC+$PIECE(DGJX,"^",1)
- +1 QUIT