DGYMF31 ;ALB/CMM FIND DANGLING PT IN ^DPT TO ^DIC(31 ;12/30/94
;;5.3;Registration;**53**;Aug 13, 1993
;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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGYMF31 1797 printed Dec 13, 2024@03:00:19 Page 2
DGYMF31 ;ALB/CMM FIND DANGLING PT IN ^DPT TO ^DIC(31 ;12/30/94
+1 ;;5.3;Registration;**53**;Aug 13, 1993
+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
