ADEPDFR1.m

ADEPDFR1 ; IHS/HQT/MJL  - DEFERRED SERVICES PT 2 ;07:07 PM  [ 03/24/1999   9:04 AM ]

 ;;6.0;ADE;;APRIL 1999

 U IO S ADEPAG=0,Y=1,$P(ADELIN,"-",81)=""

 D HDR

 D PRINT

END ;

 D ^%ZISC Q

PRINT ;

P1 S ADENAM=0 F J=0:0 S ADENAM=$O(^ADEUTIL("ADEPDFR",$J,ADENAM)) Q:ADENAM=""  Q:'Y  D P2

 Q

P2 S ADEDFN=0 F J=0:0 S ADEDFN=$O(^ADEUTIL("ADEPDFR",$J,ADENAM,ADEDFN)) Q:'ADEDFN  Q:'Y  D P3

 Q

P3 S ADENOD=^ADEUTIL("ADEPDFR",$J,ADENAM,ADEDFN)

 W !,$P(ADENOD,U),!,"(",$P(ADENOD,U,2),")",?10,$P(ADENOD,U,3)

 S ADEL=4 W !,$P(ADENOD,U,4) F ADEK=13:4:65 S ADEL=ADEL+1 W ?ADEK,$J($P(ADENOD,U,ADEL),3)

 W ?73,$J($P(ADENOD,U,21),5)

 W !

 D EOL

 Q

HDR S ADEPAG=ADEPAG+1 W @IOF,!,"DENTAL DEFERRED SERVICES REPORT",?60,$E(DT,4,5)_"-"_$E(DT,6,7)_"-"_$E(DT,2,3)

H2 W !?60,"PAGE ",ADEPAG

 ;W !,"1234567890123456789012345678901234567890123456789012345678901234567890" ;***COMMENT AND KEEP IN DISTRIBUTED VERSION

H3 W !,"PATIENT NAME"

H4 W !,"(HRN)",?9,"AGE"

 W ?13,"BAS",?17,"ANT",?21,"MOL",?25,"PER",?29,"PER",?33,"CRO",?37,"PAR",?41,"FUL",?45,"FIX",?49,"SUR",?53,"OTH",?57,"ORT",?61,"ORT",?65,"OTH",?75,"TOT"

 W !,"DATE ADDED"

 W ?13,"CAR",?17,"END",?21,"END",?25,"SMP",?29,"CPX",?33,"WNS",?37,"DEN",?41,"DEN",?45,"BRG",?49,"EXT",?53,"SUR",?57,"LTD",?61,"CPX",?65,"NDS",?75,"FEE"

 W !,ADELIN

 Q

EOL Q:$Y'>(IOSL-5)

EOL1 I $P(IOST,"-")["C" W *7 R !,X:DTIME I ('$T)!(X["^") S Y=0 Q

 D HDR Q

ADEPDFR1  ; IHS/HQT/MJL  - DEFERRED SERVICES PT 2 ;07:07 PM  [ 03/24/1999   9:04 AM ]

 +1       ;;6.0;ADE;;APRIL 1999

 +2        USE IO

           SET ADEPAG=0

           SET Y=1

           SET $PIECE(ADELIN,"-",81)=""

 +3        DO HDR

 +4        DO PRINT

END       ;

 +1        DO ^%ZISC

           QUIT 

PRINT     ;

P1         SET ADENAM=0

           FOR J=0:0

               SET ADENAM=$ORDER(^ADEUTIL("ADEPDFR",$JOB,ADENAM))

               IF ADENAM=""

                   QUIT 

               IF 'Y

                   QUIT 

               DO P2

 +1        QUIT 

P2         SET ADEDFN=0

           FOR J=0:0

               SET ADEDFN=$ORDER(^ADEUTIL("ADEPDFR",$JOB,ADENAM,ADEDFN))

               IF 'ADEDFN

                   QUIT 

               IF 'Y

                   QUIT 

               DO P3

 +1        QUIT 

P3         SET ADENOD=^ADEUTIL("ADEPDFR",$JOB,ADENAM,ADEDFN)

 +1        WRITE !,$PIECE(ADENOD,U),!,"(",$PIECE(ADENOD,U,2),")",?10,$PIECE(ADENOD,U,3)

 +2        SET ADEL=4

           WRITE !,$PIECE(ADENOD,U,4)

           FOR ADEK=13:4:65

               SET ADEL=ADEL+1

               WRITE ?ADEK,$JUSTIFY($PIECE(ADENOD,U,ADEL),3)

 +3        WRITE ?73,$JUSTIFY($PIECE(ADENOD,U,21),5)

 +4        WRITE !

 +5        DO EOL

 +6        QUIT 

HDR        SET ADEPAG=ADEPAG+1

           WRITE @IOF,!,"DENTAL DEFERRED SERVICES REPORT",?60,$EXTRACT(DT,4,5)_"-"_$EXTRACT(DT,6,7)_"-"_$EXTRACT(DT,2,3)

H2         WRITE !?60,"PAGE ",ADEPAG

 +1       ;W !,"1234567890123456789012345678901234567890123456789012345678901234567890" ;***COMMENT AND KEEP IN DISTRIBUTED VERSION

H3         WRITE !,"PATIENT NAME"

H4         WRITE !,"(HRN)",?9,"AGE"

 +1        WRITE ?13,"BAS",?17,"ANT",?21,"MOL",?25,"PER",?29,"PER",?33,"CRO",?37,"PAR",?41,"FUL",?45,"FIX",?49,"SUR",?53,"OTH",?57,"ORT",?61,"ORT",?65,"OTH",?75,"TOT"

 +2        WRITE !,"DATE ADDED"

 +3        WRITE ?13,"CAR",?17,"END",?21,"END",?25,"SMP",?29,"CPX",?33,"WNS",?37,"DEN",?41,"DEN",?45,"BRG",?49,"EXT",?53,"SUR",?57,"LTD",?61,"CPX",?65,"NDS",?75,"FEE"

 +4        WRITE !,ADELIN

 +5        QUIT 

EOL        IF $Y'>(IOSL-5)

               QUIT 

EOL1       IF $PIECE(IOST,"-")["C"

               WRITE *7

               READ !,X:DTIME

               IF ('$TEST)!(X["^")

                   SET Y=0

                   QUIT 

 +1        DO HDR

           QUIT