- 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 Feb 19, 2025@00:08:20 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