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

DGENA1A.m

Go to the documentation of this file.
  1. DGENA1A ;ALB/CJM,ISA/KWP,Zoltan,LBD,EG,CKN,ERC,TDM,JLS,HM,KUM,RN - Enrollment API - File Data Continued ;5/10/11 12:03pm
  1. ;;5.3;Registration;**121,147,232,314,564,672,659,653,688,841,909,940,972,952,993,1027,1045**;Aug 13,1993;Build 15
  1. ;
  1. KILLALL(DGENRIEN) ;
  1. ;kills all x-refs on the record in the Patient Enrollment file
  1. ;pointed to by DGENRIEN
  1. ;
  1. N DGENR,SUB,VALUE
  1. Q:'$G(DGENRIEN)
  1. Q:'$$GET^DGENA(DGENRIEN,.DGENR)
  1. S SUB=""
  1. F S SUB=$O(DGENR(SUB)) Q:SUB="" D
  1. .Q:(SUB="ELIG")
  1. .Q:DGENR(SUB)=""
  1. .D KILL(27.11,DGENRIEN,$$FIELD^DGENU(SUB),DGENR(SUB))
  1. S SUB=""
  1. F S SUB=$O(DGENR("ELIG",SUB)) Q:SUB="" D
  1. .Q:DGENR("ELIG",SUB)=""
  1. .D KILL(27.11,DGENRIEN,$$FIELD^DGENU(SUB),DGENR("ELIG",SUB))
  1. Q
  1. ;
  1. SETALL(DGENRIEN,DGENR) ;
  1. ;Sets all x-refs on the record in the Patient Enrollment file.
  1. ;Inputs:
  1. ; DGENRIEN - pointer to PATIENT ENROLLMENT file
  1. ; DGENR - array containing the record, pass by reference
  1. ;
  1. N SUB,VALUE
  1. Q:'$G(DGENRIEN)
  1. Q:'$D(DGENR)
  1. ;
  1. S SUB=""
  1. F S SUB=$O(DGENR(SUB)) Q:SUB="" D
  1. .Q:(SUB="ELIG")
  1. .Q:DGENR(SUB)=""
  1. .D SET(27.11,DGENRIEN,$$FIELD^DGENU(SUB),DGENR(SUB))
  1. S SUB=""
  1. F S SUB=$O(DGENR("ELIG",SUB)) Q:SUB="" D
  1. .Q:DGENR("ELIG",SUB)=""
  1. .D SET(27.11,DGENRIEN,$$FIELD^DGENU(SUB),DGENR("ELIG",SUB))
  1. Q
  1. ;
  1. KILL(FILE,IEN,FIELD,VALUE) ;
  1. ;executes all the kill logic for x-refs on the field=FIELD for the
  1. ;record=DGENRIEN for the file=FILE for the field value=VALUE
  1. ;
  1. N D0,DA,DIV,DGIX,X
  1. S DA=IEN,X=VALUE,DGIX=0
  1. F S DGIX=$O(^DD(FILE,FIELD,1,DGIX)) Q:'DGIX X ^(DGIX,2) S X=VALUE
  1. Q
  1. ;
  1. SET(FILE,IEN,FIELD,VALUE) ;
  1. ;executes all the set logic for x-refs on the field=FIELD for the
  1. ;record=DGENRIEN for the file=FILE for the field value=VALUE
  1. ;
  1. N D0,DA,DIV,DGIX,X
  1. S DA=IEN,X=VALUE,DGIX=0
  1. F S DGIX=$O(^DD(FILE,FIELD,1,DGIX)) Q:'DGIX X ^(DGIX,1)
  1. Q
  1. ;
  1. EDIT(DA,DGENR) ;
  1. ;Description: Overlays a currently existing record, ien=DA, with values
  1. ; from DGENR array
  1. ;Input -
  1. ; DA - ien of record in Patient Enrollment file
  1. ; DGENR - array containing an enrollment, pass by reference
  1. ;Output - 1 on success, 0 on failure
  1. ;
  1. ; *** NOTE: This is called from within FM. There is a problem in ***
  1. ; *** that ^DIE cannot be used. Instead, the fields ***
  1. ; *** are hard-set and cross-referenced. ***
  1. ;
  1. N NODE
  1. Q:'$G(DA) 0
  1. S NODE=$G(^DGEN(27.11,$G(DA),0))
  1. Q:NODE="" 0
  1. ;
  1. ;kill off all the cross-references (FM doesn't have an API to do this)
  1. D KILLALL(DA)
  1. ;
  1. ;now hand-set all the fields
  1. ;Phase II Add subgroup to the 12 piece (SRS 6.4)
  1. ;DG*5.3*993 Status being set for a Register Only Patients
  1. ;DG*5.3*1045 Status of Register Only Patients only when Ineligible Date is blank
  1. N DGEIEN,DGINELIG,DGENPTA,DGINELREA
  1. I $$GET^DGENPTA(DFN,.DGENPTA) S DGINELIG=$G(DGENPTA("INELDATE")),DGINELREA=$G(DGENPTA("INELREA"))
  1. S DGEIEN=$$FINDCUR^DGENA(DFN)
  1. I DGEIEN S DGENRYN=$$GET1^DIQ(27.11,DGEIEN_",",.14,"I")
  1. I $G(DGENRYN)=0,$G(DGINELIG)="",DGENR("STATUS")'=6,DGENR("STATUS")'=20,DGENR("SOURCE")'=2 S DGENR("STATUS")=25
  1. I $G(DGENR("PTAPPLIED"))=0,$G(DGINELIG)="",DGENR("STATUS")'=6,DGENR("STATUS")'=20,DGENR("SOURCE")'=2 S DGENR("STATUS")=25 ; DG*5.3*993
  1. ;I $G(DGINELIG)'="",$G(DGINELREA)'="",DGENR("SOURCE")'=2 S DGENR("STATUS")=20 ; DG*5.3*1045
  1. I $G(DGINELIG)'="",DGENR("SOURCE")'=2 S DGENR("STATUS")=20 ; DG*5.3*1045
  1. I $G(DGENR("REGREA"))="",DGENR("SOURCE")'=2 S DGENR("REGREA")=$$GET1^DIQ(27.11,DGEIEN_",",.15,"I")
  1. I $G(DGENR("REGDATE"))="",DGENR("SOURCE")'=2 S DGENR("REGDATE")=$$GET1^DIQ(27.11,DGEIEN_",",.16,"I")
  1. I $G(DGENR("REGSRC"))="",DGENR("SOURCE")'=2 S DGENR("REGSRC")=$$GET1^DIQ(27.11,DGEIEN_",",.17,"I")
  1. S NODE=DGENR("APP")_U_DGENR("DFN")_U_DGENR("SOURCE")_U_DGENR("STATUS")_U_DGENR("REASON")_U_DGENR("FACREC") ;DJE field added with DG*5.3*940 - Closed Application (line split) - RM#867186
  1. S NODE=NODE_U_DGENR("PRIORITY")_U_DGENR("EFFDATE")_U_DGENR("PRIORREC")_U_DGENR("DATE")_U_DGENR("END")_U_DGENR("SUBGRP")_U_DGENR("RCODE") ;DJE field added with DG*5.3*940 - Closed Application - RM#867186
  1. S ^DGEN(27.11,DA,0)=NODE
  1. S ^DGEN(27.11,DA,"R")=DGENR("REMARKS")
  1. S NODE=DGENR("ELIG","CODE")
  1. S NODE=NODE_U_DGENR("ELIG","SC")
  1. S NODE=NODE_U_DGENR("ELIG","SCPER")
  1. S NODE=NODE_U_DGENR("ELIG","POW")
  1. S NODE=NODE_U_DGENR("ELIG","A&A")
  1. S NODE=NODE_U_DGENR("ELIG","HB")
  1. S NODE=NODE_U_DGENR("ELIG","VAPEN")
  1. S NODE=NODE_U_DGENR("ELIG","VACKAMT")
  1. S NODE=NODE_U_DGENR("ELIG","DISRET")
  1. S NODE=NODE_U_DGENR("ELIG","MEDICAID")
  1. S NODE=NODE_U_DGENR("ELIG","AO")
  1. S NODE=NODE_U_DGENR("ELIG","IR")
  1. S NODE=NODE_U_DGENR("ELIG","EC") ;changed to SW Asia Cond - DG*5.3*688
  1. S NODE=NODE_U_DGENR("ELIG","MTSTA")
  1. S NODE=NODE_U_DGENR("ELIG","VCD")
  1. S NODE=NODE_U_DGENR("ELIG","PH")
  1. S NODE=NODE_U_DGENR("ELIG","UNEMPLOY")
  1. S NODE=NODE_U_DGENR("ELIG","CVELEDT")
  1. S NODE=NODE_U_DGENR("ELIG","SHAD") ;field added with DG*5.3*653
  1. S NODE=NODE_U_DGENR("ELIG","DISLOD") ;field added with DG*5.3*672
  1. S NODE=NODE_U_DGENR("ELIG","RADEXPM")
  1. S NODE=NODE_U_DGENR("ELIG","AOEXPLOC") ;field added with DG*5.3*688
  1. S NODE=NODE_U_DGENR("ELIG","MOH") ;field added with DG*5.3*841
  1. S NODE=NODE_U_DGENR("ELIG","CLE") ;field added with DG*5.3*909
  1. S NODE=NODE_U_DGENR("ELIG","CLEDT") ;field added with DG*5.3*909
  1. S NODE=NODE_U_DGENR("ELIG","CLEST") ;field added with DG*5.3*909
  1. S NODE=NODE_U_DGENR("ELIG","CLESOR") ;field added with DG*5.3*909
  1. S NODE=NODE_U_DGENR("ELIG","MOHAWRDDATE") ;field added with DG*5.3*972 HM
  1. S NODE=NODE_U_DGENR("ELIG","MOHSTATDATE") ;field added with DG*5.3*972 HM
  1. S NODE=NODE_U_DGENR("ELIG","MOHEXEMPDATE") ;field added with DG*5.3*972 HM
  1. S NODE=NODE_U_$G(DGENR("ELIG","OTHTYPE")) ; DG*5.3*952
  1. S ^DGEN(27.11,DA,"E")=NODE
  1. S ^DGEN(27.11,DA,"U")=DGENR("DATETIME")_U_DGENR("USER")
  1. ;
  1. ;DG*5.3*993 New fields for decoupling mods - update using FileMan for Auditing
  1. D
  1. . ;DG*5.3*1027 - Move update of PTAPPLIED to DGENA1
  1. . ;N DGFDA S DGFDA(27.11,DA_",",.14)=$G(DGENR("PTAPPLIED")),DGFDA(27.11,DA_",",.15)=$G(DGENR("REGREA"))
  1. . N DGFDA S DGFDA(27.11,DA_",",.15)=$G(DGENR("REGREA"))
  1. . S DGFDA(27.11,DA_",",.16)=$G(DGENR("REGDATE")),DGFDA(27.11,DA_",",.17)=$G(DGENR("REGSRC"))
  1. . D FILE^DIE("","DGFDA")
  1. ;DG*5.3*993 End of decoupling mods
  1. ;
  1. ;set the x-refs
  1. D SETALL(DA,.DGENR)
  1. Q 1