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

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

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1DG311PTR ;ALB/JJG-Patient Relation Pointer Utility ; 23 MAY 2000
2 ;;5.3;Registration;**311**;Aug 13, 1993
3 ;
4 ; This routine will be run as a post-installation routine for patch
5 ; DG*5.3*311. The main purpose for this routine is to clean up any
6 ; invalid pointers to the PATIENT RELATION file (#408.12) that may
7 ; exist in the PATIENT RELATION field (408.21,.02) of the INDIVIDUAL
8 ; ANNUAL INCOME file (#408.21).
9 ;
10POST ;entry point for post-install, setting up checkpoints
11 N %
12 I $D(XPDNM) S %=$$NEWCP^XPDUTL("DGIEN21","MAIN^DG311PTR",0)
13 Q
14MAIN ;Main Driver
15 N DGRECNT
16 S DGRECNT=0
17 D LOOP
18 Q
19LOOP ; Locate and correct invalid pointers
20 N DGIEN21,DGIEN22,DGNOD22,DGIEN2,DGRLIEN
21 S DGIEN21=""
22 I $D(XPDNM) S DGIEN21=+$$PARCP^XPDUTL("DGIEN21")
23 F S DGIEN21=$O(^DGMT(408.21,"C",0,DGIEN21)) Q:'DGIEN21 D
24 .S DGIEN22=0
25 .S DGIEN22=$O(^DGMT(408.22,"AIND",DGIEN21,DGIEN22)) Q:'DGIEN22
26 .S DGNOD22=$G(^DGMT(408.22,DGIEN22,0))
27 .S DGIEN2=$P(DGNOD22,"^") Q:'DGIEN2
28 .S DGRLIEN=0
29 .S DGRLIEN=$O(^DGPR(408.12,"B",DGIEN2,DGRLIEN)) Q:'DGRLIEN
30 .D UPDATE
31 .I $D(XPDNM) S %=$$UPCP^XPDUTL("DGIEN21",DGIEN21) ; Update Checkpoint
32 Q
33UPDATE ;Update .02 field in Individual Annual Income file
34 N DATA,DGENDA,ERROR
35 S DATA(.02)=DGRLIEN,DGENDA=DGIEN21,ERROR=""
36 I $$UPD^DGENDBS(408.21,.DGENDA,.DATA,.ERROR) D
37 .S DGRECNT=DGRECNT+1
38 Q
Note: See TracBrowser for help on using the repository browser.