DGYMF31.m

DGYMF31 ;ALB/CMM FIND DANGLING PT IN ^DPT TO ^DIC(31 ;12/30/94

 ;;5.3;Registration;**53,1015**;Aug 13, 1993;Build 21

 ;This is a one shot routine that will loop through the patient

 ;file entries looking at the disabilities to see if the pointer

 ;values are valid to file 31 (disability conditions file).

EN ;

 ;prompt to delete bad pointers (y/n) BADDEL

 W @IOF

 S DIR("A",1)="Do you want to delete the bad pointer in the Patient file"

 S DIR("A")="that point to the Disability Condition file"

 S DIR(0)="Y",DIR("B")="NO",DIR("?")="Enter yes to delete the bad pointers, no to leave the pointers"

 D ^DIR I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT,DIRUT,DIR,Y,X Q

 I Y=1 S BADDEL="Y"

 I Y=0 S BADDEL="N"

 K DIRUT,DTOUT,DOUT,DIR,X,Y

 I '$D(BADDEL) G EN

 ;prompt to include valid disabilities for patients with invalid pts. (y/n) INVALID

 W !

 S DIR("A")="Do you want to include valid disabilities in report"

 S DIR(0)="Y",DIR("B")="YES",DIR("?")="Enter yes to see the patient's valid disabilities on the report"

 D ^DIR I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT,DIRUT,DIR,Y,X Q

 I Y=1 S INVALID="Y"

 I Y=0 S INVALID="N"

 K DUOUT,DTOUT,DIRUT,DIR,X,Y

 I '$D(INVALID) G EN

 W !!!,"***NOTE: - This report requires 132 columns.",!

 ;Make job queueable - don't create data if queued

 S %ZIS="Q" D ^%ZIS K %ZIS G:POP EXIT

 I $D(IO("Q")) D  G EXQ

 .S ZTIO=ION,ZTDESC="PATIENT FILE CLEAN UP DISABILITY CONDITION BAD POINTERS",ZTRTN="DRIVE^DGYMF31A"

 .F LI="BADDEL","INVALID" S ZTSAVE(LI)=""

 .D ^%ZTLOAD I $D(ZTSK) W !!,"Request has been queued",!!

 D DRIVE^DGYMF31A

 D EXIT

 Q

EXQ K ZTSAVE,ZTDESC,ZTRTN,INVALID,BADDEL,LI Q

EXIT ;

 D ^%ZISC

 K FOUND,NXT,DFN,CNT,PTR,ANY,CPT,DEAD,INDEX,ANS,INVALID,BADDEL,X,SSN

 K DIRUT,DIR,Y,PAGE,END,%ZIS,LP,POP,LAST,ZTSK,ZTIO,DUOUT,DTOUT,^TMP($J,"DG31")

 Q

DGYMF31   ;ALB/CMM FIND DANGLING PT IN ^DPT TO ^DIC(31 ;12/30/94

 +1       ;;5.3;Registration;**53,1015**;Aug 13, 1993;Build 21

 +2       ;This is a one shot routine that will loop through the patient

 +3       ;file entries looking at the disabilities to see if the pointer

 +4       ;values are valid to file 31 (disability conditions file).

EN        ;

 +1       ;prompt to delete bad pointers (y/n) BADDEL

 +2        WRITE @IOF

 +3        SET DIR("A",1)="Do you want to delete the bad pointer in the Patient file"

 +4        SET DIR("A")="that point to the Disability Condition file"

 +5        SET DIR(0)="Y"

           SET DIR("B")="NO"

           SET DIR("?")="Enter yes to delete the bad pointers, no to leave the pointers"

 +6        DO ^DIR

           IF $DATA(DUOUT)!$DATA(DTOUT)

               KILL DUOUT,DTOUT,DIRUT,DIR,Y,X

               QUIT 

 +7        IF Y=1

               SET BADDEL="Y"

 +8        IF Y=0

               SET BADDEL="N"

 +9        KILL DIRUT,DTOUT,DOUT,DIR,X,Y

 +10       IF '$DATA(BADDEL)

               GOTO EN

 +11      ;prompt to include valid disabilities for patients with invalid pts. (y/n) INVALID

 +12       WRITE !

 +13       SET DIR("A")="Do you want to include valid disabilities in report"

 +14       SET DIR(0)="Y"

           SET DIR("B")="YES"

           SET DIR("?")="Enter yes to see the patient's valid disabilities on the report"

 +15       DO ^DIR

           IF $DATA(DUOUT)!$DATA(DTOUT)

               KILL DUOUT,DTOUT,DIRUT,DIR,Y,X

               QUIT 

 +16       IF Y=1

               SET INVALID="Y"

 +17       IF Y=0

               SET INVALID="N"

 +18       KILL DUOUT,DTOUT,DIRUT,DIR,X,Y

 +19       IF '$DATA(INVALID)

               GOTO EN

 +20       WRITE !!!,"***NOTE: - This report requires 132 columns.",!

 +21      ;Make job queueable - don't create data if queued

 +22       SET %ZIS="Q"

           DO ^%ZIS

           KILL %ZIS

           IF POP

               GOTO EXIT

 +23       IF $DATA(IO("Q"))

               Begin DoDot:1

 +24               SET ZTIO=ION

                   SET ZTDESC="PATIENT FILE CLEAN UP DISABILITY CONDITION BAD POINTERS"

                   SET ZTRTN="DRIVE^DGYMF31A"

 +25               FOR LI="BADDEL","INVALID"

                       SET ZTSAVE(LI)=""

 +26               DO ^%ZTLOAD

                   IF $DATA(ZTSK)

                       WRITE !!,"Request has been queued",!!

               End DoDot:1

               GOTO EXQ

 +27       DO DRIVE^DGYMF31A

 +28       DO EXIT

 +29       QUIT 

EXQ        KILL ZTSAVE,ZTDESC,ZTRTN,INVALID,BADDEL,LI

           QUIT 

EXIT      ;

 +1        DO ^%ZISC

 +2        KILL FOUND,NXT,DFN,CNT,PTR,ANY,CPT,DEAD,INDEX,ANS,INVALID,BADDEL,X,SSN

 +3        KILL DIRUT,DIR,Y,PAGE,END,%ZIS,LP,POP,LAST,ZTSK,ZTIO,DUOUT,DTOUT,^TMP($JOB,"DG31")

 +4        QUIT