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
;;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
;
KILLALL(DGENRIEN) ;
;kills all x-refs on the record in the Patient Enrollment file
;pointed to by DGENRIEN
;
N DGENR,SUB,VALUE
Q:'$G(DGENRIEN)
Q:'$$GET^DGENA(DGENRIEN,.DGENR)
S SUB=""
F S SUB=$O(DGENR(SUB)) Q:SUB="" D
.Q:(SUB="ELIG")
.Q:DGENR(SUB)=""
.D KILL(27.11,DGENRIEN,$$FIELD^DGENU(SUB),DGENR(SUB))
S SUB=""
F S SUB=$O(DGENR("ELIG",SUB)) Q:SUB="" D
.Q:DGENR("ELIG",SUB)=""
.D KILL(27.11,DGENRIEN,$$FIELD^DGENU(SUB),DGENR("ELIG",SUB))
Q
;
SETALL(DGENRIEN,DGENR) ;
;Sets all x-refs on the record in the Patient Enrollment file.
;Inputs:
; DGENRIEN - pointer to PATIENT ENROLLMENT file
; DGENR - array containing the record, pass by reference
;
N SUB,VALUE
Q:'$G(DGENRIEN)
Q:'$D(DGENR)
;
S SUB=""
F S SUB=$O(DGENR(SUB)) Q:SUB="" D
.Q:(SUB="ELIG")
.Q:DGENR(SUB)=""
.D SET(27.11,DGENRIEN,$$FIELD^DGENU(SUB),DGENR(SUB))
S SUB=""
F S SUB=$O(DGENR("ELIG",SUB)) Q:SUB="" D
.Q:DGENR("ELIG",SUB)=""
.D SET(27.11,DGENRIEN,$$FIELD^DGENU(SUB),DGENR("ELIG",SUB))
Q
;
KILL(FILE,IEN,FIELD,VALUE) ;
;executes all the kill logic for x-refs on the field=FIELD for the
;record=DGENRIEN for the file=FILE for the field value=VALUE
;
N D0,DA,DIV,DGIX,X
S DA=IEN,X=VALUE,DGIX=0
F S DGIX=$O(^DD(FILE,FIELD,1,DGIX)) Q:'DGIX X ^(DGIX,2) S X=VALUE
Q
;
SET(FILE,IEN,FIELD,VALUE) ;
;executes all the set logic for x-refs on the field=FIELD for the
;record=DGENRIEN for the file=FILE for the field value=VALUE
;
N D0,DA,DIV,DGIX,X
S DA=IEN,X=VALUE,DGIX=0
F S DGIX=$O(^DD(FILE,FIELD,1,DGIX)) Q:'DGIX X ^(DGIX,1)
Q
;
EDIT(DA,DGENR) ;
;Description: Overlays a currently existing record, ien=DA, with values
; from DGENR array
;Input -
; DA - ien of record in Patient Enrollment file
; DGENR - array containing an enrollment, pass by reference
;Output - 1 on success, 0 on failure
;
; *** NOTE: This is called from within FM. There is a problem in ***
; *** that ^DIE cannot be used. Instead, the fields ***
; *** are hard-set and cross-referenced. ***
;
N NODE
Q:'$G(DA) 0
S NODE=$G(^DGEN(27.11,$G(DA),0))
Q:NODE="" 0
;
;kill off all the cross-references (FM doesn't have an API to do this)
D KILLALL(DA)
;
;now hand-set all the fields
;Phase II Add subgroup to the 12 piece (SRS 6.4)
;DG*5.3*993 Status being set for a Register Only Patients
;DG*5.3*1045 Status of Register Only Patients only when Ineligible Date is blank
N DGEIEN,DGINELIG,DGENPTA,DGINELREA
I $$GET^DGENPTA(DFN,.DGENPTA) S DGINELIG=$G(DGENPTA("INELDATE")),DGINELREA=$G(DGENPTA("INELREA"))
S DGEIEN=$$FINDCUR^DGENA(DFN)
I DGEIEN S DGENRYN=$$GET1^DIQ(27.11,DGEIEN_",",.14,"I")
I $G(DGENRYN)=0,$G(DGINELIG)="",DGENR("STATUS")'=6,DGENR("STATUS")'=20,DGENR("SOURCE")'=2 S DGENR("STATUS")=25
I $G(DGENR("PTAPPLIED"))=0,$G(DGINELIG)="",DGENR("STATUS")'=6,DGENR("STATUS")'=20,DGENR("SOURCE")'=2 S DGENR("STATUS")=25 ; DG*5.3*993
;I $G(DGINELIG)'="",$G(DGINELREA)'="",DGENR("SOURCE")'=2 S DGENR("STATUS")=20 ; DG*5.3*1045
I $G(DGINELIG)'="",DGENR("SOURCE")'=2 S DGENR("STATUS")=20 ; DG*5.3*1045
I $G(DGENR("REGREA"))="",DGENR("SOURCE")'=2 S DGENR("REGREA")=$$GET1^DIQ(27.11,DGEIEN_",",.15,"I")
I $G(DGENR("REGDATE"))="",DGENR("SOURCE")'=2 S DGENR("REGDATE")=$$GET1^DIQ(27.11,DGEIEN_",",.16,"I")
I $G(DGENR("REGSRC"))="",DGENR("SOURCE")'=2 S DGENR("REGSRC")=$$GET1^DIQ(27.11,DGEIEN_",",.17,"I")
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
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
S ^DGEN(27.11,DA,0)=NODE
S ^DGEN(27.11,DA,"R")=DGENR("REMARKS")
S NODE=DGENR("ELIG","CODE")
S NODE=NODE_U_DGENR("ELIG","SC")
S NODE=NODE_U_DGENR("ELIG","SCPER")
S NODE=NODE_U_DGENR("ELIG","POW")
S NODE=NODE_U_DGENR("ELIG","A&A")
S NODE=NODE_U_DGENR("ELIG","HB")
S NODE=NODE_U_DGENR("ELIG","VAPEN")
S NODE=NODE_U_DGENR("ELIG","VACKAMT")
S NODE=NODE_U_DGENR("ELIG","DISRET")
S NODE=NODE_U_DGENR("ELIG","MEDICAID")
S NODE=NODE_U_DGENR("ELIG","AO")
S NODE=NODE_U_DGENR("ELIG","IR")
S NODE=NODE_U_DGENR("ELIG","EC") ;changed to SW Asia Cond - DG*5.3*688
S NODE=NODE_U_DGENR("ELIG","MTSTA")
S NODE=NODE_U_DGENR("ELIG","VCD")
S NODE=NODE_U_DGENR("ELIG","PH")
S NODE=NODE_U_DGENR("ELIG","UNEMPLOY")
S NODE=NODE_U_DGENR("ELIG","CVELEDT")
S NODE=NODE_U_DGENR("ELIG","SHAD") ;field added with DG*5.3*653
S NODE=NODE_U_DGENR("ELIG","DISLOD") ;field added with DG*5.3*672
S NODE=NODE_U_DGENR("ELIG","RADEXPM")
S NODE=NODE_U_DGENR("ELIG","AOEXPLOC") ;field added with DG*5.3*688
S NODE=NODE_U_DGENR("ELIG","MOH") ;field added with DG*5.3*841
S NODE=NODE_U_DGENR("ELIG","CLE") ;field added with DG*5.3*909
S NODE=NODE_U_DGENR("ELIG","CLEDT") ;field added with DG*5.3*909
S NODE=NODE_U_DGENR("ELIG","CLEST") ;field added with DG*5.3*909
S NODE=NODE_U_DGENR("ELIG","CLESOR") ;field added with DG*5.3*909
S NODE=NODE_U_DGENR("ELIG","MOHAWRDDATE") ;field added with DG*5.3*972 HM
S NODE=NODE_U_DGENR("ELIG","MOHSTATDATE") ;field added with DG*5.3*972 HM
S NODE=NODE_U_DGENR("ELIG","MOHEXEMPDATE") ;field added with DG*5.3*972 HM
S NODE=NODE_U_$G(DGENR("ELIG","OTHTYPE")) ; DG*5.3*952
S ^DGEN(27.11,DA,"E")=NODE
S ^DGEN(27.11,DA,"U")=DGENR("DATETIME")_U_DGENR("USER")
;
;DG*5.3*993 New fields for decoupling mods - update using FileMan for Auditing
D
. ;DG*5.3*1027 - Move update of PTAPPLIED to DGENA1
. ;N DGFDA S DGFDA(27.11,DA_",",.14)=$G(DGENR("PTAPPLIED")),DGFDA(27.11,DA_",",.15)=$G(DGENR("REGREA"))
. N DGFDA S DGFDA(27.11,DA_",",.15)=$G(DGENR("REGREA"))
. S DGFDA(27.11,DA_",",.16)=$G(DGENR("REGDATE")),DGFDA(27.11,DA_",",.17)=$G(DGENR("REGSRC"))
. D FILE^DIE("","DGFDA")
;DG*5.3*993 End of decoupling mods
;
;set the x-refs
D SETALL(DA,.DGENR)
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENA1A 6292 printed Apr 09, 2024@21:42:19 Page 2
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
+2 ;
KILLALL(DGENRIEN) ;
+1 ;kills all x-refs on the record in the Patient Enrollment file
+2 ;pointed to by DGENRIEN
+3 ;
+4 NEW DGENR,SUB,VALUE
+5 if '$GET(DGENRIEN)
QUIT
+6 if '$$GET^DGENA(DGENRIEN,.DGENR)
QUIT
+7 SET SUB=""
+8 FOR
SET SUB=$ORDER(DGENR(SUB))
if SUB=""
QUIT
Begin DoDot:1
+9 if (SUB="ELIG")
QUIT
+10 if DGENR(SUB)=""
QUIT
+11 DO KILL(27.11,DGENRIEN,$$FIELD^DGENU(SUB),DGENR(SUB))
End DoDot:1
+12 SET SUB=""
+13 FOR
SET SUB=$ORDER(DGENR("ELIG",SUB))
if SUB=""
QUIT
Begin DoDot:1
+14 if DGENR("ELIG",SUB)=""
QUIT
+15 DO KILL(27.11,DGENRIEN,$$FIELD^DGENU(SUB),DGENR("ELIG",SUB))
End DoDot:1
+16 QUIT
+17 ;
SETALL(DGENRIEN,DGENR) ;
+1 ;Sets all x-refs on the record in the Patient Enrollment file.
+2 ;Inputs:
+3 ; DGENRIEN - pointer to PATIENT ENROLLMENT file
+4 ; DGENR - array containing the record, pass by reference
+5 ;
+6 NEW SUB,VALUE
+7 if '$GET(DGENRIEN)
QUIT
+8 if '$DATA(DGENR)
QUIT
+9 ;
+10 SET SUB=""
+11 FOR
SET SUB=$ORDER(DGENR(SUB))
if SUB=""
QUIT
Begin DoDot:1
+12 if (SUB="ELIG")
QUIT
+13 if DGENR(SUB)=""
QUIT
+14 DO SET(27.11,DGENRIEN,$$FIELD^DGENU(SUB),DGENR(SUB))
End DoDot:1
+15 SET SUB=""
+16 FOR
SET SUB=$ORDER(DGENR("ELIG",SUB))
if SUB=""
QUIT
Begin DoDot:1
+17 if DGENR("ELIG",SUB)=""
QUIT
+18 DO SET(27.11,DGENRIEN,$$FIELD^DGENU(SUB),DGENR("ELIG",SUB))
End DoDot:1
+19 QUIT
+20 ;
KILL(FILE,IEN,FIELD,VALUE) ;
+1 ;executes all the kill logic for x-refs on the field=FIELD for the
+2 ;record=DGENRIEN for the file=FILE for the field value=VALUE
+3 ;
+4 NEW D0,DA,DIV,DGIX,X
+5 SET DA=IEN
SET X=VALUE
SET DGIX=0
+6 FOR
SET DGIX=$ORDER(^DD(FILE,FIELD,1,DGIX))
if 'DGIX
QUIT
XECUTE ^(DGIX,2)
SET X=VALUE
+7 QUIT
+8 ;
SET(FILE,IEN,FIELD,VALUE) ;
+1 ;executes all the set logic for x-refs on the field=FIELD for the
+2 ;record=DGENRIEN for the file=FILE for the field value=VALUE
+3 ;
+4 NEW D0,DA,DIV,DGIX,X
+5 SET DA=IEN
SET X=VALUE
SET DGIX=0
+6 FOR
SET DGIX=$ORDER(^DD(FILE,FIELD,1,DGIX))
if 'DGIX
QUIT
XECUTE ^(DGIX,1)
+7 QUIT
+8 ;
EDIT(DA,DGENR) ;
+1 ;Description: Overlays a currently existing record, ien=DA, with values
+2 ; from DGENR array
+3 ;Input -
+4 ; DA - ien of record in Patient Enrollment file
+5 ; DGENR - array containing an enrollment, pass by reference
+6 ;Output - 1 on success, 0 on failure
+7 ;
+8 ; *** NOTE: This is called from within FM. There is a problem in ***
+9 ; *** that ^DIE cannot be used. Instead, the fields ***
+10 ; *** are hard-set and cross-referenced. ***
+11 ;
+12 NEW NODE
+13 if '$GET(DA)
QUIT 0
+14 SET NODE=$GET(^DGEN(27.11,$GET(DA),0))
+15 if NODE=""
QUIT 0
+16 ;
+17 ;kill off all the cross-references (FM doesn't have an API to do this)
+18 DO KILLALL(DA)
+19 ;
+20 ;now hand-set all the fields
+21 ;Phase II Add subgroup to the 12 piece (SRS 6.4)
+22 ;DG*5.3*993 Status being set for a Register Only Patients
+23 ;DG*5.3*1045 Status of Register Only Patients only when Ineligible Date is blank
+24 NEW DGEIEN,DGINELIG,DGENPTA,DGINELREA
+25 IF $$GET^DGENPTA(DFN,.DGENPTA)
SET DGINELIG=$GET(DGENPTA("INELDATE"))
SET DGINELREA=$GET(DGENPTA("INELREA"))
+26 SET DGEIEN=$$FINDCUR^DGENA(DFN)
+27 IF DGEIEN
SET DGENRYN=$$GET1^DIQ(27.11,DGEIEN_",",.14,"I")
+28 IF $GET(DGENRYN)=0
IF $GET(DGINELIG)=""
IF DGENR("STATUS")'=6
IF DGENR("STATUS")'=20
IF DGENR("SOURCE")'=2
SET DGENR("STATUS")=25
+29 ; DG*5.3*993
IF $GET(DGENR("PTAPPLIED"))=0
IF $GET(DGINELIG)=""
IF DGENR("STATUS")'=6
IF DGENR("STATUS")'=20
IF DGENR("SOURCE")'=2
SET DGENR("STATUS")=25
+30 ;I $G(DGINELIG)'="",$G(DGINELREA)'="",DGENR("SOURCE")'=2 S DGENR("STATUS")=20 ; DG*5.3*1045
+31 ; DG*5.3*1045
IF $GET(DGINELIG)'=""
IF DGENR("SOURCE")'=2
SET DGENR("STATUS")=20
+32 IF $GET(DGENR("REGREA"))=""
IF DGENR("SOURCE")'=2
SET DGENR("REGREA")=$$GET1^DIQ(27.11,DGEIEN_",",.15,"I")
+33 IF $GET(DGENR("REGDATE"))=""
IF DGENR("SOURCE")'=2
SET DGENR("REGDATE")=$$GET1^DIQ(27.11,DGEIEN_",",.16,"I")
+34 IF $GET(DGENR("REGSRC"))=""
IF DGENR("SOURCE")'=2
SET DGENR("REGSRC")=$$GET1^DIQ(27.11,DGEIEN_",",.17,"I")
+35 ;DJE field added with DG*5.3*940 - Closed Application (line split) - RM#867186
SET NODE=DGENR("APP")_U_DGENR("DFN")_U_DGENR("SOURCE")_U_DGENR("STATUS")_U_DGENR("REASON")_U_DGENR("FACREC")
+36 ;DJE field added with DG*5.3*940 - Closed Application - RM#867186
SET NODE=NODE_U_DGENR("PRIORITY")_U_DGENR("EFFDATE")_U_DGENR("PRIORREC")_U_DGENR("DATE")_U_DGENR("END")_U_DGENR("SUBGRP")_U_DGENR("RCODE")
+37 SET ^DGEN(27.11,DA,0)=NODE
+38 SET ^DGEN(27.11,DA,"R")=DGENR("REMARKS")
+39 SET NODE=DGENR("ELIG","CODE")
+40 SET NODE=NODE_U_DGENR("ELIG","SC")
+41 SET NODE=NODE_U_DGENR("ELIG","SCPER")
+42 SET NODE=NODE_U_DGENR("ELIG","POW")
+43 SET NODE=NODE_U_DGENR("ELIG","A&A")
+44 SET NODE=NODE_U_DGENR("ELIG","HB")
+45 SET NODE=NODE_U_DGENR("ELIG","VAPEN")
+46 SET NODE=NODE_U_DGENR("ELIG","VACKAMT")
+47 SET NODE=NODE_U_DGENR("ELIG","DISRET")
+48 SET NODE=NODE_U_DGENR("ELIG","MEDICAID")
+49 SET NODE=NODE_U_DGENR("ELIG","AO")
+50 SET NODE=NODE_U_DGENR("ELIG","IR")
+51 ;changed to SW Asia Cond - DG*5.3*688
SET NODE=NODE_U_DGENR("ELIG","EC")
+52 SET NODE=NODE_U_DGENR("ELIG","MTSTA")
+53 SET NODE=NODE_U_DGENR("ELIG","VCD")
+54 SET NODE=NODE_U_DGENR("ELIG","PH")
+55 SET NODE=NODE_U_DGENR("ELIG","UNEMPLOY")
+56 SET NODE=NODE_U_DGENR("ELIG","CVELEDT")
+57 ;field added with DG*5.3*653
SET NODE=NODE_U_DGENR("ELIG","SHAD")
+58 ;field added with DG*5.3*672
SET NODE=NODE_U_DGENR("ELIG","DISLOD")
+59 SET NODE=NODE_U_DGENR("ELIG","RADEXPM")
+60 ;field added with DG*5.3*688
SET NODE=NODE_U_DGENR("ELIG","AOEXPLOC")
+61 ;field added with DG*5.3*841
SET NODE=NODE_U_DGENR("ELIG","MOH")
+62 ;field added with DG*5.3*909
SET NODE=NODE_U_DGENR("ELIG","CLE")
+63 ;field added with DG*5.3*909
SET NODE=NODE_U_DGENR("ELIG","CLEDT")
+64 ;field added with DG*5.3*909
SET NODE=NODE_U_DGENR("ELIG","CLEST")
+65 ;field added with DG*5.3*909
SET NODE=NODE_U_DGENR("ELIG","CLESOR")
+66 ;field added with DG*5.3*972 HM
SET NODE=NODE_U_DGENR("ELIG","MOHAWRDDATE")
+67 ;field added with DG*5.3*972 HM
SET NODE=NODE_U_DGENR("ELIG","MOHSTATDATE")
+68 ;field added with DG*5.3*972 HM
SET NODE=NODE_U_DGENR("ELIG","MOHEXEMPDATE")
+69 ; DG*5.3*952
SET NODE=NODE_U_$GET(DGENR("ELIG","OTHTYPE"))
+70 SET ^DGEN(27.11,DA,"E")=NODE
+71 SET ^DGEN(27.11,DA,"U")=DGENR("DATETIME")_U_DGENR("USER")
+72 ;
+73 ;DG*5.3*993 New fields for decoupling mods - update using FileMan for Auditing
+74 Begin DoDot:1
+75 ;DG*5.3*1027 - Move update of PTAPPLIED to DGENA1
+76 ;N DGFDA S DGFDA(27.11,DA_",",.14)=$G(DGENR("PTAPPLIED")),DGFDA(27.11,DA_",",.15)=$G(DGENR("REGREA"))
+77 NEW DGFDA
SET DGFDA(27.11,DA_",",.15)=$GET(DGENR("REGREA"))
+78 SET DGFDA(27.11,DA_",",.16)=$GET(DGENR("REGDATE"))
SET DGFDA(27.11,DA_",",.17)=$GET(DGENR("REGSRC"))
+79 DO FILE^DIE("","DGFDA")
End DoDot:1
+80 ;DG*5.3*993 End of decoupling mods
+81 ;
+82 ;set the x-refs
+83 DO SETALL(DA,.DGENR)
+84 QUIT 1
