ADEFIX01.m

ADEFIX01 ;IHS/HQW/MJL - SEND MISSING DATA TO PCC;  [ 11/03/1999  2:22 PM ]

 ;;6.0;ADE;**2**;NOVEMBER 1999

START ;

 W !!,"This option will update the PCC with the dental procedures skipped"

 W !,"starting from 12/1/98 through the current period."

 S DIR(0)="YA",DIR("B")="YES",DIR("A")="Continue? "

 D ^DIR Q:'Y

 I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) Q

 S ZTRTN="EP^ADEFIX01",ZTDESC="DENTAL UPDATE PCC WITH MISSING PROCEDURES",ZTIO=""

 D ^%ZTLOAD

 Q

 ;

EP ;

 S ADESTDT=2981200,ADENEWVS=1,ADESTDT=$O(^ADEPCD("AC",ADESTDT)) Q:'ADESTDT  S ADEDFN=$O(^ADEPCD("AC",ADESTDT,0))-1

 F  S ADEDFN=$O(^ADEPCD(ADEDFN)) Q:'ADEDFN  I '$D(^ADEPCD(ADEDFN,"PCC")) S ADEPAT=^ADEPCD(ADEDFN,0),ADEVDATE=$P(ADEPAT,U,2),ADECON=$P(ADEPAT,U,9),ADEPAT=$P(ADEPAT,U) S:ADECON="c" ADECON=1,ADEDIR=0 S:ADECON'="C" ADECON=0,ADEDIR=1 D ^ADEAPC

 Q

ADEFIX01  ;IHS/HQW/MJL - SEND MISSING DATA TO PCC;  [ 11/03/1999  2:22 PM ]

 +1       ;;6.0;ADE;**2**;NOVEMBER 1999

START     ;

 +1        WRITE !!,"This option will update the PCC with the dental procedures skipped"

 +2        WRITE !,"starting from 12/1/98 through the current period."

 +3        SET DIR(0)="YA"

           SET DIR("B")="YES"

           SET DIR("A")="Continue? "

 +4        DO ^DIR

           IF 'Y

               QUIT 

 +5        IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))

               QUIT 

 +6        SET ZTRTN="EP^ADEFIX01"

           SET ZTDESC="DENTAL UPDATE PCC WITH MISSING PROCEDURES"

           SET ZTIO=""

 +7        DO ^%ZTLOAD

 +8        QUIT 

 +9       ;

EP        ;

 +1        SET ADESTDT=2981200

           SET ADENEWVS=1

           SET ADESTDT=$ORDER(^ADEPCD("AC",ADESTDT))

           IF 'ADESTDT

               QUIT 

           SET ADEDFN=$ORDER(^ADEPCD("AC",ADESTDT,0))-1

 +2        FOR 

               SET ADEDFN=$ORDER(^ADEPCD(ADEDFN))

               IF 'ADEDFN

                   QUIT 

               IF '$DATA(^ADEPCD(ADEDFN,"PCC"))

                   SET ADEPAT=^ADEPCD(ADEDFN,0)

                   SET ADEVDATE=$PIECE(ADEPAT,U,2)

                   SET ADECON=$PIECE(ADEPAT,U,9)

                   SET ADEPAT=$PIECE(ADEPAT,U)

                   IF ADECON="c"

                       SET ADECON=1

                       SET ADEDIR=0

                   IF ADECON'="C"

                       SET ADECON=0

                       SET ADEDIR=1

                   DO ^ADEAPC

 +3        QUIT