DGFCPROT ;FLB/ALB-DG Field Monitor cross-reference initialing routine. ;06/24/2010 10:51
;;5.3;Registration;**273,526,707,825**;AUG 13, 1993;Build 1
;
FC(DGDA,DGFILE,DGFIELD,DGTYPE,DGDTH,DGUSER,DGX,DGX1,DGX2,DGOPT) ; Field change listener
;Input: DGDA = DA array as exists during Fileman editing
;Input: DGFILE = File or subfile number where changed field resides
;Input: DGFIELD = Number of changed field
;Input: DGTYPE = Type of cross reference action ("SET" or "KILL")
;Input: DGDTH = date/time of change in $Horolog format
;Input: DGUSER = DUZ of user that made the change
;Input: DGX = X array as documented for Fileman new style x-refs
;Input: DGX1 = X1 array as documented for Fileman new style x-refs
;Input: DGX2 = X2 array as documented for Fileman new style x-refs
;Input: DGOPT = current option in "option_name^menu_text" format
;
;This utility invokes the DG FIELD MONITOR event point protocol.
;The DG variables as described above are made available to the
;subscribers of this event point.
;
;NOTE: This event point is not invoked if the action type is "KILL"
; and the old field value is null or the new value is not null.
; It is not invoked if the action type is "SET" and the new
; field value is null.
;
Q:DGX="" ;Quit if setting or killing null value
;
I DGTYPE="KILL",DGX2]"" Q ;Skip kill action on data update
;
;Manipulate DGTYPE value
S DGTYPE=$S(DGTYPE="KILL":"DELETE",DGTYPE="SET":"ADD",1:DGTYPE)
I DGX1]"",DGX2]"" S DGTYPE="UPDATE"
;
S DGOPT=$P(DGOPT,U,1,2) S:DGOPT="" DGOPT="-1^Unknown" ;Current option
; **825,MPIC_2114
;see if in reg option and save off values before getting into taskman task job and out of line with reg option
I $$REG^VAFCDD01() D Q
.I (DGFIELD=994)!(DGFIELD=.525)!(DGFIELD=.0906)!(DGFIELD=.121)!(DGFIELD=.133)!(DGFIELD=.134) S VAFCFLDS(DGFIELD_";")=""
.;The fields below ARE multiples
.I DGFILE=2.01 S VAFCF="1;" S VAFCFLDS(VAFCF)="" ;ALIAS
.I DGFILE=2.02 S VAFCF="2.02,.01;" S VAFCFLDS(VAFCF)="" ;RACE INFORMATION
.I DGFILE=2.06 S VAFCF="2.06,.01;" S VAFCFLDS(VAFCF)="" ;ETHNICITY INFORMATION
;
;Task off (Taskman) driver routine.
N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,ZTSK,DGVAR,BXREF,SUBSCR,ZTREQ
S ZTRTN="INIT^DGFCPROT",ZTDESC="DG Field monitor task"
S ZTIO="DG FIELD MONITOR",ZTDTH=$$NOW^XLFDT
F DGVAR="DGDA","DGDA(","DGFILE","DGFIELD","DGTYPE","DGDTH","DGUSER","DGX","DGX(","DGX1","DGX1(","DGX2","DGX2(","DGOPT" S ZTSAVE(DGVAR)=""
;If there are no subscribers, do not call Taskman
I $D(VAFCA08) S ZTSAVE("VAFCA08")=VAFCA08 ;**707
I $D(VAFHCA08) S ZTSAVE("VAFHCA08")=VAFHCA08 ;**707
S BXREF=0,BXREF=$O(^ORD(101,"B","DG FIELD MONITOR",BXREF))
S SUBSCR=0,SUBSCR=$O(^ORD(101,BXREF,10,SUBSCR))
I 'SUBSCR Q
D ^%ZTLOAD
Q
;
INIT N X
S X=$O(^ORD(101,"B","DG FIELD MONITOR",0))_";ORD(101," D EN1^XQOR
I $D(ZTQUEUED) S ZTREQ="@"
K DGDA,DGFILE,DGFIELD,DGTYPE,DGDTH,DGUSER,DGX,DGX1,DGX2,DGOPT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGFCPROT 2974 printed Sep 23, 2025@20:19:19 Page 2
DGFCPROT ;FLB/ALB-DG Field Monitor cross-reference initialing routine. ;06/24/2010 10:51
+1 ;;5.3;Registration;**273,526,707,825**;AUG 13, 1993;Build 1
+2 ;
FC(DGDA,DGFILE,DGFIELD,DGTYPE,DGDTH,DGUSER,DGX,DGX1,DGX2,DGOPT) ; Field change listener
+1 ;Input: DGDA = DA array as exists during Fileman editing
+2 ;Input: DGFILE = File or subfile number where changed field resides
+3 ;Input: DGFIELD = Number of changed field
+4 ;Input: DGTYPE = Type of cross reference action ("SET" or "KILL")
+5 ;Input: DGDTH = date/time of change in $Horolog format
+6 ;Input: DGUSER = DUZ of user that made the change
+7 ;Input: DGX = X array as documented for Fileman new style x-refs
+8 ;Input: DGX1 = X1 array as documented for Fileman new style x-refs
+9 ;Input: DGX2 = X2 array as documented for Fileman new style x-refs
+10 ;Input: DGOPT = current option in "option_name^menu_text" format
+11 ;
+12 ;This utility invokes the DG FIELD MONITOR event point protocol.
+13 ;The DG variables as described above are made available to the
+14 ;subscribers of this event point.
+15 ;
+16 ;NOTE: This event point is not invoked if the action type is "KILL"
+17 ; and the old field value is null or the new value is not null.
+18 ; It is not invoked if the action type is "SET" and the new
+19 ; field value is null.
+20 ;
+21 ;Quit if setting or killing null value
if DGX=""
QUIT
+22 ;
+23 ;Skip kill action on data update
IF DGTYPE="KILL"
IF DGX2]""
QUIT
+24 ;
+25 ;Manipulate DGTYPE value
+26 SET DGTYPE=$SELECT(DGTYPE="KILL":"DELETE",DGTYPE="SET":"ADD",1:DGTYPE)
+27 IF DGX1]""
IF DGX2]""
SET DGTYPE="UPDATE"
+28 ;
+29 ;Current option
SET DGOPT=$PIECE(DGOPT,U,1,2)
if DGOPT=""
SET DGOPT="-1^Unknown"
+30 ; **825,MPIC_2114
+31 ;see if in reg option and save off values before getting into taskman task job and out of line with reg option
+32 IF $$REG^VAFCDD01()
Begin DoDot:1
+33 IF (DGFIELD=994)!(DGFIELD=.525)!(DGFIELD=.0906)!(DGFIELD=.121)!(DGFIELD=.133)!(DGFIELD=.134)
SET VAFCFLDS(DGFIELD_";")=""
+34 ;The fields below ARE multiples
+35 ;ALIAS
IF DGFILE=2.01
SET VAFCF="1;"
SET VAFCFLDS(VAFCF)=""
+36 ;RACE INFORMATION
IF DGFILE=2.02
SET VAFCF="2.02,.01;"
SET VAFCFLDS(VAFCF)=""
+37 ;ETHNICITY INFORMATION
IF DGFILE=2.06
SET VAFCF="2.06,.01;"
SET VAFCFLDS(VAFCF)=""
End DoDot:1
QUIT
+38 ;
+39 ;Task off (Taskman) driver routine.
+40 NEW ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,ZTSK,DGVAR,BXREF,SUBSCR,ZTREQ
+41 SET ZTRTN="INIT^DGFCPROT"
SET ZTDESC="DG Field monitor task"
+42 SET ZTIO="DG FIELD MONITOR"
SET ZTDTH=$$NOW^XLFDT
+43 FOR DGVAR="DGDA","DGDA(","DGFILE","DGFIELD","DGTYPE","DGDTH","DGUSER","DGX","DGX(","DGX1","DGX1(","DGX2","DGX2(","DGOPT"
SET ZTSAVE(DGVAR)=""
+44 ;If there are no subscribers, do not call Taskman
+45 ;**707
IF $DATA(VAFCA08)
SET ZTSAVE("VAFCA08")=VAFCA08
+46 ;**707
IF $DATA(VAFHCA08)
SET ZTSAVE("VAFHCA08")=VAFHCA08
+47 SET BXREF=0
SET BXREF=$ORDER(^ORD(101,"B","DG FIELD MONITOR",BXREF))
+48 SET SUBSCR=0
SET SUBSCR=$ORDER(^ORD(101,BXREF,10,SUBSCR))
+49 IF 'SUBSCR
QUIT
+50 DO ^%ZTLOAD
+51 QUIT
+52 ;
INIT NEW X
+1 SET X=$ORDER(^ORD(101,"B","DG FIELD MONITOR",0))_";ORD(101,"
DO EN1^XQOR
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 KILL DGDA,DGFILE,DGFIELD,DGTYPE,DGDTH,DGUSER,DGX,DGX1,DGX2,DGOPT
+4 QUIT
