- 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 Feb 19, 2025@00:09:30 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