Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DG311PTR

DG311PTR.m

Go to the documentation of this file.
  1. DG311PTR ;ALB/JJG-Patient Relation Pointer Utility ; 23 MAY 2000
  1. ;;5.3;Registration;**311**;Aug 13, 1993
  1. ;
  1. ; This routine will be run as a post-installation routine for patch
  1. ; DG*5.3*311. The main purpose for this routine is to clean up any
  1. ; invalid pointers to the PATIENT RELATION file (#408.12) that may
  1. ; exist in the PATIENT RELATION field (408.21,.02) of the INDIVIDUAL
  1. ; ANNUAL INCOME file (#408.21).
  1. ;
  1. POST ;entry point for post-install, setting up checkpoints
  1. N %
  1. I $D(XPDNM) S %=$$NEWCP^XPDUTL("DGIEN21","MAIN^DG311PTR",0)
  1. Q
  1. MAIN ;Main Driver
  1. N DGRECNT
  1. S DGRECNT=0
  1. D LOOP
  1. Q
  1. LOOP ; Locate and correct invalid pointers
  1. N DGIEN21,DGIEN22,DGNOD22,DGIEN2,DGRLIEN
  1. S DGIEN21=""
  1. I $D(XPDNM) S DGIEN21=+$$PARCP^XPDUTL("DGIEN21")
  1. F S DGIEN21=$O(^DGMT(408.21,"C",0,DGIEN21)) Q:'DGIEN21 D
  1. .S DGIEN22=0
  1. .S DGIEN22=$O(^DGMT(408.22,"AIND",DGIEN21,DGIEN22)) Q:'DGIEN22
  1. .S DGNOD22=$G(^DGMT(408.22,DGIEN22,0))
  1. .S DGIEN2=$P(DGNOD22,"^") Q:'DGIEN2
  1. .S DGRLIEN=0
  1. .S DGRLIEN=$O(^DGPR(408.12,"B",DGIEN2,DGRLIEN)) Q:'DGRLIEN
  1. .D UPDATE
  1. .I $D(XPDNM) S %=$$UPCP^XPDUTL("DGIEN21",DGIEN21) ; Update Checkpoint
  1. Q
  1. UPDATE ;Update .02 field in Individual Annual Income file
  1. N DATA,DGENDA,ERROR
  1. S DATA(.02)=DGRLIEN,DGENDA=DGIEN21,ERROR=""
  1. I $$UPD^DGENDBS(408.21,.DGENDA,.DATA,.ERROR) D
  1. .S DGRECNT=DGRECNT+1
  1. Q