ADGDSIP2.m

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