DGENA1A ;ALB/CJM,ISA/KWP,Zoltan,LBD,EG,CKN,ERC - Enrollment API - File Data Continued ; 8/1/08 1:10pm
;;5.3;PIMS;**121,147,232,314,564,672,659,653,688,1015,1016**;JUN 30, 2012;Build 20
;
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 - ptr 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 can not 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)
S NODE=DGENR("APP")_U_DGENR("DFN")_U_DGENR("SOURCE")_U_DGENR("STATUS")_U_DGENR("REASON")_U_DGENR("FACREC")_U_DGENR("PRIORITY")_U_DGENR("EFFDATE")_U_DGENR("PRIORREC")_U_DGENR("DATE")_U_DGENR("END")_U_DGENR("SUBGRP")
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 ^DGEN(27.11,DA,"E")=NODE
S ^DGEN(27.11,DA,"U")=DGENR("DATETIME")_U_DGENR("USER")
;
;set the x-refs
D SETALL(DA,.DGENR)
Q 1
DGENA1A ;ALB/CJM,ISA/KWP,Zoltan,LBD,EG,CKN,ERC - Enrollment API - File Data Continued ; 8/1/08 1:10pm
+1 ;;5.3;PIMS;**121,147,232,314,564,672,659,653,688,1015,1016**;JUN 30, 2012;Build 20
+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 - ptr 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 can not 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 SET NODE=DGENR("APP")_U_DGENR("DFN")_U_DGENR("SOURCE")_U_DGENR("STATUS")_U_DGENR("REASON")_U_DGENR("FACREC")_U_DGENR("PRIORITY")_U_DGENR("EFFDATE")_U_DGENR("PRIORREC")_U_DGENR("DATE")_U_DGENR("END")_U_DGENR("SUBGRP")
+23 SET ^DGEN(27.11,DA,0)=NODE
+24 SET ^DGEN(27.11,DA,"R")=DGENR("REMARKS")
+25 SET NODE=DGENR("ELIG","CODE")
+26 SET NODE=NODE_U_DGENR("ELIG","SC")
+27 SET NODE=NODE_U_DGENR("ELIG","SCPER")
+28 SET NODE=NODE_U_DGENR("ELIG","POW")
+29 SET NODE=NODE_U_DGENR("ELIG","A&A")
+30 SET NODE=NODE_U_DGENR("ELIG","HB")
+31 SET NODE=NODE_U_DGENR("ELIG","VAPEN")
+32 SET NODE=NODE_U_DGENR("ELIG","VACKAMT")
+33 SET NODE=NODE_U_DGENR("ELIG","DISRET")
+34 SET NODE=NODE_U_DGENR("ELIG","MEDICAID")
+35 SET NODE=NODE_U_DGENR("ELIG","AO")
+36 SET NODE=NODE_U_DGENR("ELIG","IR")
+37 ;changed to SW Asia Cond - DG*5.3*688
SET NODE=NODE_U_DGENR("ELIG","EC")
+38 SET NODE=NODE_U_DGENR("ELIG","MTSTA")
+39 SET NODE=NODE_U_DGENR("ELIG","VCD")
+40 SET NODE=NODE_U_DGENR("ELIG","PH")
+41 SET NODE=NODE_U_DGENR("ELIG","UNEMPLOY")
+42 SET NODE=NODE_U_DGENR("ELIG","CVELEDT")
+43 ;field added with DG*5.3*653
SET NODE=NODE_U_DGENR("ELIG","SHAD")
+44 ;field added with DG*5.3*672
SET NODE=NODE_U_DGENR("ELIG","DISLOD")
+45 SET NODE=NODE_U_DGENR("ELIG","RADEXPM")
+46 ;field added with DG*5.3*688
SET NODE=NODE_U_DGENR("ELIG","AOEXPLOC")
+47 SET ^DGEN(27.11,DA,"E")=NODE
+48 SET ^DGEN(27.11,DA,"U")=DGENR("DATETIME")_U_DGENR("USER")
+49 ;
+50 ;set the x-refs
+51 DO SETALL(DA,.DGENR)
+52 QUIT 1
