DGFCPROT.m

DGFCPROT ;FLB/ALB-DG Field Monitor cross-reference initialing routine. ;06/24/2010 10:51

 ;;5.3;PIMS;**273,526,707,1015,1016**;JUN 30, 2012;Build 20

 ;

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

DGFCPROT  ;FLB/ALB-DG Field Monitor cross-reference initialing routine. ;06/24/2010 10:51

 +1       ;;5.3;PIMS;**273,526,707,1015,1016**;JUN 30, 2012;Build 20

 +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