- ADGDSIP2 ; IHS/ADC/PDW/ENM - DS CHART DEFICIENCY LIST ; [ 03/25/1999 11:48 AM ]
- ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
- ;
- F DGI=1:1:5 S DGTOT(DGI)=0
- A ; -- main
- D H,L Q:DGSTOP=U D 1 Q
- ;
- H ;
- W @IOF,!!?80-$L(DGFAC)/2,DGFAC
- W !,DGDUZ,?20,"DAY SURGERY INCOMPLETE CHARTS BY PROVIDER"
- W !,$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3),?34,"SUMMARY PAGE"
- W !!?25,"INCOMP",?41,"DELINQ"
- W !,"PROVIDER",?25,"CHARTS",?34,"SIG",?41,"CHARTS",?49,"OP RPT"
- W ?57,"SIGNATURE",!,DGLIN
- Q
- ;
- L ;
- S DGPRVN=""
- F S DGPRVN=$O(^TMP("DGZICPL1",$J,DGPRVN)) Q:DGPRVN=""!(DGSTOP=U) D
- . Q:DGPRVN="Z" Q:DGPRVN="ZZ"
- . S DGSTR=^TMP("DGZICPL1",$J,DGPRVN) D T
- Q
- ;
- 1 ;
- N X S DGTOT(1)=0,X=0
- F S X=$O(^TMP("DGZICPL1",$J,"Z",X)) Q:X="" S DGTOT(1)=DGTOT(1)+1
- ;
- S DGTOT(3)=0,X=0
- F S X=$O(^TMP("DGZICPL1",$J,"ZZ",X)) Q:X="" S DGTOT(3)=DGTOT(3)+1
- ;
- W !!,DGLIN,!,"TOTALS:"
- S DGX=17 F DGI=1:1:5 W ?(DGX+(DGI*8)),$J(DGTOT(DGI),3)
- Q
- ;
- T I $Y>(IOSL-4) D NEWPG Q:DGSTOP=U
- W !,$E(DGPRVN,1,15),?25,$J($P(DGSTR,U),3)
- W ?33,$J($P(DGSTR,U,2),3),?41,$J($P(DGSTR,U,3),3)
- W ?49,$J($P(DGSTR,U,4),3),?57,$J($P(DGSTR,U,5),3)
- F DGJ=1:1:5 S DGTOT(DGJ)=DGTOT(DGJ)+$P(DGSTR,U,DGJ)
- Q
- ;
- NEWPG ; -- end of page control
- ;--printer
- I IOST'?1"C-".E D H Q
- ;--terminal
- K DIR S DIR(0)="E" D ^DIR S DGSTOP=X
- Q:X=U D H Q
- ADGDSIP2 ; IHS/ADC/PDW/ENM - DS CHART DEFICIENCY LIST ; [ 03/25/1999 11:48 AM ]
- +1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
- +2 ;
- +3 FOR DGI=1:1:5
- SET DGTOT(DGI)=0
- A ; -- main
- +1 DO H
- DO L
- IF DGSTOP=U
- QUIT
- DO 1
- QUIT
- +2 ;
- H ;
- +1 WRITE @IOF,!!?80-$LENGTH(DGFAC)/2,DGFAC
- +2 WRITE !,DGDUZ,?20,"DAY SURGERY INCOMPLETE CHARTS BY PROVIDER"
- +3 WRITE !,$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3),?34,"SUMMARY PAGE"
- +4 WRITE !!?25,"INCOMP",?41,"DELINQ"
- +5 WRITE !,"PROVIDER",?25,"CHARTS",?34,"SIG",?41,"CHARTS",?49,"OP RPT"
- +6 WRITE ?57,"SIGNATURE",!,DGLIN
- +7 QUIT
- +8 ;
- L ;
- +1 SET DGPRVN=""
- +2 FOR
- SET DGPRVN=$ORDER(^TMP("DGZICPL1",$JOB,DGPRVN))
- IF DGPRVN=""!(DGSTOP=U)
- QUIT
- Begin DoDot:1
- +3 IF DGPRVN="Z"
- QUIT
- IF DGPRVN="ZZ"
- QUIT
- +4 SET DGSTR=^TMP("DGZICPL1",$JOB,DGPRVN)
- DO T
- End DoDot:1
- +5 QUIT
- +6 ;
- 1 ;
- +1 NEW X
- SET DGTOT(1)=0
- SET X=0
- +2 FOR
- SET X=$ORDER(^TMP("DGZICPL1",$JOB,"Z",X))
- IF X=""
- QUIT
- SET DGTOT(1)=DGTOT(1)+1
- +3 ;
- +4 SET DGTOT(3)=0
- SET X=0
- +5 FOR
- SET X=$ORDER(^TMP("DGZICPL1",$JOB,"ZZ",X))
- IF X=""
- QUIT
- SET DGTOT(3)=DGTOT(3)+1
- +6 ;
- +7 WRITE !!,DGLIN,!,"TOTALS:"
- +8 SET DGX=17
- FOR DGI=1:1:5
- WRITE ?(DGX+(DGI*8)),$JUSTIFY(DGTOT(DGI),3)
- +9 QUIT
- +10 ;
- T IF $Y>(IOSL-4)
- DO NEWPG
- IF DGSTOP=U
- QUIT
- +1 WRITE !,$EXTRACT(DGPRVN,1,15),?25,$JUSTIFY($PIECE(DGSTR,U),3)
- +2 WRITE ?33,$JUSTIFY($PIECE(DGSTR,U,2),3),?41,$JUSTIFY($PIECE(DGSTR,U,3),3)
- +3 WRITE ?49,$JUSTIFY($PIECE(DGSTR,U,4),3),?57,$JUSTIFY($PIECE(DGSTR,U,5),3)
- +4 FOR DGJ=1:1:5
- SET DGTOT(DGJ)=DGTOT(DGJ)+$PIECE(DGSTR,U,DGJ)
- +5 QUIT
- +6 ;
- NEWPG ; -- end of page control
- +1 ;--printer
- +2 IF IOST'?1"C-".E
- DO H
- QUIT
- +3 ;--terminal
- +4 KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- SET DGSTOP=X
- +5 IF X=U
- QUIT
- DO H
- QUIT
