source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGYMF31.m@ 1141

Last change on this file since 1141 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.7 KB
RevLine 
[613]1DGYMF31 ;ALB/CMM FIND DANGLING PT IN ^DPT TO ^DIC(31 ;12/30/94
2 ;;5.3;Registration;**53**;Aug 13, 1993
3 ;This is a one shot routine that will loop through the patient
4 ;file entries looking at the disabilities to see if the pointer
5 ;values are valid to file 31 (disability conditions file).
6EN ;
7 ;prompt to delete bad pointers (y/n) BADDEL
8 W @IOF
9 S DIR("A",1)="Do you want to delete the bad pointer in the Patient file"
10 S DIR("A")="that point to the Disability Condition file"
11 S DIR(0)="Y",DIR("B")="NO",DIR("?")="Enter yes to delete the bad pointers, no to leave the pointers"
12 D ^DIR I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT,DIRUT,DIR,Y,X Q
13 I Y=1 S BADDEL="Y"
14 I Y=0 S BADDEL="N"
15 K DIRUT,DTOUT,DOUT,DIR,X,Y
16 I '$D(BADDEL) G EN
17 ;prompt to include valid disabilities for patients with invalid pts. (y/n) INVALID
18 W !
19 S DIR("A")="Do you want to include valid disabilities in report"
20 S DIR(0)="Y",DIR("B")="YES",DIR("?")="Enter yes to see the patient's valid disabilities on the report"
21 D ^DIR I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT,DIRUT,DIR,Y,X Q
22 I Y=1 S INVALID="Y"
23 I Y=0 S INVALID="N"
24 K DUOUT,DTOUT,DIRUT,DIR,X,Y
25 I '$D(INVALID) G EN
26 W !!!,"***NOTE: - This report requires 132 columns.",!
27 ;Make job queueable - don't create data if queued
28 S %ZIS="Q" D ^%ZIS K %ZIS G:POP EXIT
29 I $D(IO("Q")) D G EXQ
30 .S ZTIO=ION,ZTDESC="PATIENT FILE CLEAN UP DISABILITY CONDITION BAD POINTERS",ZTRTN="DRIVE^DGYMF31A"
31 .F LI="BADDEL","INVALID" S ZTSAVE(LI)=""
32 .D ^%ZTLOAD I $D(ZTSK) W !!,"Request has been queued",!!
33 D DRIVE^DGYMF31A
34 D EXIT
35 Q
36EXQ K ZTSAVE,ZTDESC,ZTRTN,INVALID,BADDEL,LI Q
37EXIT ;
38 D ^%ZISC
39 K FOUND,NXT,DFN,CNT,PTR,ANY,CPT,DEAD,INDEX,ANS,INVALID,BADDEL,X,SSN
40 K DIRUT,DIR,Y,PAGE,END,%ZIS,LP,POP,LAST,ZTSK,ZTIO,DUOUT,DTOUT,^TMP($J,"DG31")
41 Q
Note: See TracBrowser for help on using the repository browser.