| 1 | DG311PTR ;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 | ;
|
|---|
| 10 | POST ;entry point for post-install, setting up checkpoints
|
|---|
| 11 | N %
|
|---|
| 12 | I $D(XPDNM) S %=$$NEWCP^XPDUTL("DGIEN21","MAIN^DG311PTR",0)
|
|---|
| 13 | Q
|
|---|
| 14 | MAIN ;Main Driver
|
|---|
| 15 | N DGRECNT
|
|---|
| 16 | S DGRECNT=0
|
|---|
| 17 | D LOOP
|
|---|
| 18 | Q
|
|---|
| 19 | LOOP ; 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
|
|---|
| 33 | UPDATE ;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
|
|---|
