AGFLDREQ.m

AGFLDREQ ; IHS/SD/TPF - DEVELOPER TOOL TO ADD REQUIRED FIELDS TO THE REQUIRED FIELD MULTIPLE IN THE REGISTRATION PARAMETER FILE

 ;;7.1;PATIENT REGISTRATION;**2,9**;AUG 25, 2005

 ;

 ;IN ORDER TO SET UP THE SITE SPECIFIC MANDATORY FIELDS DO THE FOLLOWING

 ;EDIT THE 'REGISTRATION PARAMETER' FILE

 ;            'MANDATORY FIELDS'

 ;                   'REQUIRED FIELDS'

 ;AND ENTER THE FILE AND THEN THEN FIELDS WITHIN THAT FILE YOU WISH

 ;TO ALLOW SITES TO SET

 ;LOCALLY AS REQUIRED OR NOT. THIS DOES NOT OVERRIDE FILEMEN REQUIRED

 ;FIELDS AND CAN ONLY

 ;BE USED FOR FIELDS THAT HAVE NO REQ SETTING IN THE FILEMAN DD.

 ;

 ;GENERALLY ADDING OF LOCAL REQ FIELDS WILL BE DONE BY DEVELOPERS. EVEN

 ;IF THE FIELD IS

 ;SET UP FOR LOCAL SETTINGS IT WILL NOT BE IN AFFECT UNTIL THE PROPER CODE

 ;IS ADDED TO

 ;THE PAT REG SCREEN ROUTINE. AFTER IT IS ADDED TO THE

 ;'REGISTRATION PARAMETER' FILE THE

 ;FOLLOWING CODE SHOULD BE ADDED TO THE APPROPRAIRE ROUTINE WHERE THE

 ;FIELD IS EDITED.

 ;

 ;            I $$ISREQ^AGFLDREQ(file or subfile #,field #) S

 ;                                               DIE("NO^"),DR=field#_"R"

 ;            E  S DR=field#

 ;

 ;THE FORMAT AT THIS TIME IS LIMITED TO CHECKING ONE FIELD AT A TIME.

 ;EACH EDIT CALL MAY HAVE TO BE MODIFIED TO ACCOUNT

 ;FOR THIS LIMITATION.

 ;

 ;THE SITE CAN THEN USE THE 'AGFAC' INPUT TEMPLATE VIA OPTION 'AGOPT'

 ;TO EDIT THE SETTING FOR EACH OF THE FIELDS

 ;

 Q  ;NOT TO BE RUN FROM ROOT

GETFIELD(A,B,X) ;EP - CALLED FROM INPUT TRANSFORM OF FIELD 9009061.1101 'REQUIRED FIELD NAME' SUB-FIELD

 N DIC,DIE,Y,DO

 ;GO THROUGH AND SEE IF THE FIELD IS IN THE TOP LEVEL FILE

 S TOPFILE=+$P(^AGFAC(A,11,B,0),U)

 S DIC="^DD("_TOPFILE_","

 S DIC(0)="EX"  ;SET THIS TO EX WHEN ADDING ITEMS IN AN INSTALL

 ;S DIC(0)="E"

 D ^DIC

 I +Y<0 D SUBFILES(TOPFILE,.X,.Y)

 I +Y<0 K X Q

 S X=$P(Y,U,2)

 Q

SUBFILES(TOPFILE,X,Y) ;GO THROUGH THE NEXT LEVEL OF SUB FILES AND FIND

 ;IT THERE

 N DIC,DIE,DO

 S SUBFILE=TOPFILE

 F  S SUBFILE=$O(^DD(TOPFILE,"SB",SUBFILE)) Q:SUBFILE=""  D  Q:+Y>0

 .S DIC="^DD("_SUBFILE_","

 .S DIC(0)="EX"  ;SET THIS TO EX WHEN ADDING ITEMS IN AN INSTALL

 .;S DIC(0)="E"

 .D ^DIC

 Q

 ;IS THIS A SITE SPECIFIC REQUIRED FLD?

 ;FILENUM = FILE OR SUBFILE #

 ;FIELDNUM = FLD #

 ;WILL BE CALLLED FROM VARIOUS PAT REG SCREENS

ISREQ(FILENUM,FIELDNUM) ;EP - USE TO VERIFY A SITE SPECIFIC MANDATORY FIELD IS SET FOR REQUIRED

 K RETURN,ERROR

 N FIELDIEN,FILEIEN

 D FIELD^DID(FILENUM,FIELDNUM,,"LABEL","RETURN","ERROR")

 Q:$D(ERROR) 0  ;ERROR CAN'T FIND FILE OR FIELD??

 S FIELDNAM=RETURN("LABEL")

 S FILEIEN=$O(^AGFAC(DUZ(2),11,"B",FILENUM,""))

 Q:FILEIEN="" 0  ;ERROR CAN'T FIND RECORD FOR THIS FILE #

 S FIELDIEN=$O(^AGFAC(DUZ(2),11,FILEIEN,1,"B",FIELDNAM,""))

 Q:FIELDIEN="" 0  ;ERROR CAN'T FIND RECORD FOR THIS FLD #

 Q $P($G(^AGFAC(DUZ(2),11,FILEIEN,1,FIELDIEN,0)),U,2)

 ;THIS IS USED TO LOOP THROUGH THE SITE SPECIFIC MANDATORY FIELDS AND ALLOW THE USER TO

 ;SET IT AS REQUIRED OR NOT

EDIT ;EP - CALLED FROM INPUT TEMPLATE 'AGFAC' TO EDIT SITE SPECIFIC REQUIRED FIELDS

 ;AG*7.1*9 - Set up FACIEN which is needed to update the correct facility

 ;         - Changed DUZ(20 references to use FACIEN to update the correct facility

 N FILENUM,FIELDNUM,FILEIEN,FACIEN

 S FACIEN=$G(DA)

 ;

 N DIE,DIC,DA,D0,DO,DR,X,Y,DP,%,D,DC,DE,DG,DH,DI,DIA,DIEDA,DIEL,DIETMP,DIFLD,DIIENS,DILK,DIP,DISYS,DK,DL,DM,DQ,DSC,DU,DV,DW,DXS,L

 K RETURN,ERROR

 W !!,"Mandatory Fields (site specific) edit:"

 S FILENUM=0

 F  S FILENUM=$O(^AGFAC(FACIEN,11,"B",FILENUM)) Q:'FILENUM  D  Q:$D(Y)

 .S FILEIEN=0

 .F  S FILEIEN=$O(^AGFAC(FACIEN,11,"B",FILENUM,FILEIEN)) Q:'FILEIEN  D  Q:$D(Y)

 ..D FILE^DID(FILENUM,,"NAME","RETURN","ERROR")

 ..I $D(ERROR) W !,"CAN'T FIND FILE. POSSIBLE FILE CORRUPTION IN ^AGFAC" Q  ;CAN'T FIND FILE

 ..W !!,"Now setting requirement for fields within file ",RETURN("NAME")

 ..S FIELDNAM=0

 ..F  S FIELDNAM=$O(^AGFAC(FACIEN,11,FILEIEN,1,"B",FIELDNAM)) Q:FIELDNAM=""  D  Q:$D(Y)

 ...S FIELDIEN=$O(^AGFAC(FACIEN,11,FILEIEN,1,"B",FIELDNAM,""))

 ...W !?8,"Require entry of field "_$S(FIELDNAM["ETHNICITY":"ETHNICITY",1:FIELDNAM)_" ?" ;AG*7.1*9 - Special code for ETHNICITY

 ...K DIC,DIE,DR,DA

 ...S DA=FIELDIEN

 ...S DA(2)=FACIEN

 ...S DA(1)=FILEIEN

 ...S DIE="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"

 ...S DR=.02

 ...S DR(2,9009061.11)=.01

 ...S DR(3,9009061.1101)=.02

 ...S DIE("NO^")="OUTOK"

 ...D ^DIE

 ...;

 ...;Special code for Print Ethnicity On FaceSheet - AG*7.1*9

 ...I FILENUM=2,FIELDNAM="ETHNICITY INFORMATION" D  Q

 ....K DA,DR,DIE

 ....S DA=FACIEN

 ....S DIE="^AGFAC("

 ....S DR=501

 ....D ^DIE

 ....K DA,DR,DIE

 ...;

 ...;Special code for Print Race On FaceSheet - AG*7.1*9

 ...I FILENUM=2,FIELDNAM="RACE" D  Q

 ....K DA,DR,DIE

 ....S DA=FACIEN

 ....S DIE="^AGFAC("

 ....S DR=503

 ....D ^DIE

 ....K DA,DR,DIE

 Q

RESTRICT(IEN) ;EP - RESTRICT FILE CHOICE TO PATIENT REG FILES OR

 ;SPECIFIC AUP,AUT FILES

 Q 0

 ;

 ;AG*7.1*9 - Special check for mandatory multiple subfields

ALTREQ(FILENUM,FIELDNM) ;EP - ALTERNATE CHECK FOR SITE SPECIFIC MANDATORY FIELDS (HANDLES MULTIPLE SUBFIELDS)

 ;^AGFAC Structure does not allow multiple subfields to be entered so the are entered for the parent file

 ;This call will look up the multiple subfield by its name

 N FLIEN,FDIEN

 S FLIEN=$O(^AGFAC(DUZ(2),11,"B",FILENUM,"")) Q:FLIEN="" 0

 S FDIEN=$O(^AGFAC(DUZ(2),11,FLIEN,1,"B",FIELDNM,"")) Q:FDIEN="" 0

 Q $P($G(^AGFAC(DUZ(2),11,FLIEN,1,FDIEN,0)),U,2)

AGFLDREQ  ; IHS/SD/TPF - DEVELOPER TOOL TO ADD REQUIRED FIELDS TO THE REQUIRED FIELD MULTIPLE IN THE REGISTRATION PARAMETER FILE

 +1       ;;7.1;PATIENT REGISTRATION;**2,9**;AUG 25, 2005

 +2       ;

 +3       ;IN ORDER TO SET UP THE SITE SPECIFIC MANDATORY FIELDS DO THE FOLLOWING

 +4       ;EDIT THE 'REGISTRATION PARAMETER' FILE

 +5       ;            'MANDATORY FIELDS'

 +6       ;                   'REQUIRED FIELDS'

 +7       ;AND ENTER THE FILE AND THEN THEN FIELDS WITHIN THAT FILE YOU WISH

 +8       ;TO ALLOW SITES TO SET

 +9       ;LOCALLY AS REQUIRED OR NOT. THIS DOES NOT OVERRIDE FILEMEN REQUIRED

 +10      ;FIELDS AND CAN ONLY

 +11      ;BE USED FOR FIELDS THAT HAVE NO REQ SETTING IN THE FILEMAN DD.

 +12      ;

 +13      ;GENERALLY ADDING OF LOCAL REQ FIELDS WILL BE DONE BY DEVELOPERS. EVEN

 +14      ;IF THE FIELD IS

 +15      ;SET UP FOR LOCAL SETTINGS IT WILL NOT BE IN AFFECT UNTIL THE PROPER CODE

 +16      ;IS ADDED TO

 +17      ;THE PAT REG SCREEN ROUTINE. AFTER IT IS ADDED TO THE

 +18      ;'REGISTRATION PARAMETER' FILE THE

 +19      ;FOLLOWING CODE SHOULD BE ADDED TO THE APPROPRAIRE ROUTINE WHERE THE

 +20      ;FIELD IS EDITED.

 +21      ;

 +22      ;            I $$ISREQ^AGFLDREQ(file or subfile #,field #) S

 +23      ;                                               DIE("NO^"),DR=field#_"R"

 +24      ;            E  S DR=field#

 +25      ;

 +26      ;THE FORMAT AT THIS TIME IS LIMITED TO CHECKING ONE FIELD AT A TIME.

 +27      ;EACH EDIT CALL MAY HAVE TO BE MODIFIED TO ACCOUNT

 +28      ;FOR THIS LIMITATION.

 +29      ;

 +30      ;THE SITE CAN THEN USE THE 'AGFAC' INPUT TEMPLATE VIA OPTION 'AGOPT'

 +31      ;TO EDIT THE SETTING FOR EACH OF THE FIELDS

 +32      ;

 +33      ;NOT TO BE RUN FROM ROOT

           QUIT 

GETFIELD(A,B,X) ;EP - CALLED FROM INPUT TRANSFORM OF FIELD 9009061.1101 'REQUIRED FIELD NAME' SUB-FIELD

 +1        NEW DIC,DIE,Y,DO

 +2       ;GO THROUGH AND SEE IF THE FIELD IS IN THE TOP LEVEL FILE

 +3        SET TOPFILE=+$PIECE(^AGFAC(A,11,B,0),U)

 +4        SET DIC="^DD("_TOPFILE_","

 +5       ;SET THIS TO EX WHEN ADDING ITEMS IN AN INSTALL

           SET DIC(0)="EX"

 +6       ;S DIC(0)="E"

 +7        DO ^DIC

 +8        IF +Y<0

               DO SUBFILES(TOPFILE,.X,.Y)

 +9        IF +Y<0

               KILL X

               QUIT 

 +10       SET X=$PIECE(Y,U,2)

 +11       QUIT 

SUBFILES(TOPFILE,X,Y) ;GO THROUGH THE NEXT LEVEL OF SUB FILES AND FIND

 +1       ;IT THERE

 +2        NEW DIC,DIE,DO

 +3        SET SUBFILE=TOPFILE

 +4        FOR 

               SET SUBFILE=$ORDER(^DD(TOPFILE,"SB",SUBFILE))

               IF SUBFILE=""

                   QUIT 

               Begin DoDot:1

 +5                SET DIC="^DD("_SUBFILE_","

 +6       ;SET THIS TO EX WHEN ADDING ITEMS IN AN INSTALL

                   SET DIC(0)="EX"

 +7       ;S DIC(0)="E"

 +8                DO ^DIC

               End DoDot:1

               IF +Y>0

                   QUIT 

 +9        QUIT 

 +10      ;IS THIS A SITE SPECIFIC REQUIRED FLD?

 +11      ;FILENUM = FILE OR SUBFILE #

 +12      ;FIELDNUM = FLD #

 +13      ;WILL BE CALLLED FROM VARIOUS PAT REG SCREENS

ISREQ(FILENUM,FIELDNUM) ;EP - USE TO VERIFY A SITE SPECIFIC MANDATORY FIELD IS SET FOR REQUIRED

 +1        KILL RETURN,ERROR

 +2        NEW FIELDIEN,FILEIEN

 +3        DO FIELD^DID(FILENUM,FIELDNUM,,"LABEL","RETURN","ERROR")

 +4       ;ERROR CAN'T FIND FILE OR FIELD??

           IF $DATA(ERROR)

               QUIT 0

 +5        SET FIELDNAM=RETURN("LABEL")

 +6        SET FILEIEN=$ORDER(^AGFAC(DUZ(2),11,"B",FILENUM,""))

 +7       ;ERROR CAN'T FIND RECORD FOR THIS FILE #

           IF FILEIEN=""

               QUIT 0

 +8        SET FIELDIEN=$ORDER(^AGFAC(DUZ(2),11,FILEIEN,1,"B",FIELDNAM,""))

 +9       ;ERROR CAN'T FIND RECORD FOR THIS FLD #

           IF FIELDIEN=""

               QUIT 0

 +10       QUIT $PIECE($GET(^AGFAC(DUZ(2),11,FILEIEN,1,FIELDIEN,0)),U,2)

 +11      ;THIS IS USED TO LOOP THROUGH THE SITE SPECIFIC MANDATORY FIELDS AND ALLOW THE USER TO

 +12      ;SET IT AS REQUIRED OR NOT

EDIT      ;EP - CALLED FROM INPUT TEMPLATE 'AGFAC' TO EDIT SITE SPECIFIC REQUIRED FIELDS

 +1       ;AG*7.1*9 - Set up FACIEN which is needed to update the correct facility

 +2       ;         - Changed DUZ(20 references to use FACIEN to update the correct facility

 +3        NEW FILENUM,FIELDNUM,FILEIEN,FACIEN

 +4        SET FACIEN=$GET(DA)

 +5       ;

 +6        NEW DIE,DIC,DA,D0,DO,DR,X,Y,DP,%,D,DC,DE,DG,DH,DI,DIA,DIEDA,DIEL,DIETMP,DIFLD,DIIENS,DILK,DIP,DISYS,DK,DL,DM,DQ,DSC,DU,DV,DW,DXS,L

 +7        KILL RETURN,ERROR

 +8        WRITE !!,"Mandatory Fields (site specific) edit:"

 +9        SET FILENUM=0

 +10       FOR 

               SET FILENUM=$ORDER(^AGFAC(FACIEN,11,"B",FILENUM))

               IF 'FILENUM

                   QUIT 

               Begin DoDot:1

 +11               SET FILEIEN=0

 +12               FOR 

                       SET FILEIEN=$ORDER(^AGFAC(FACIEN,11,"B",FILENUM,FILEIEN))

                       IF 'FILEIEN

                           QUIT 

                       Begin DoDot:2

 +13                       DO FILE^DID(FILENUM,,"NAME","RETURN","ERROR")

 +14      ;CAN'T FIND FILE

                           IF $DATA(ERROR)

                               WRITE !,"CAN'T FIND FILE. POSSIBLE FILE CORRUPTION IN ^AGFAC"

                               QUIT 

 +15                       WRITE !!,"Now setting requirement for fields within file ",RETURN("NAME")

 +16                       SET FIELDNAM=0

 +17                       FOR 

                               SET FIELDNAM=$ORDER(^AGFAC(FACIEN,11,FILEIEN,1,"B",FIELDNAM))

                               IF FIELDNAM=""

                                   QUIT 

                               Begin DoDot:3

 +18                               SET FIELDIEN=$ORDER(^AGFAC(FACIEN,11,FILEIEN,1,"B",FIELDNAM,""))

 +19      ;AG*7.1*9 - Special code for ETHNICITY

                                   WRITE !?8,"Require entry of field "_$SELECT(FIELDNAM["ETHNICITY":"ETHNICITY",1:FIELDNAM)_" ?"

 +20                               KILL DIC,DIE,DR,DA

 +21                               SET DA=FIELDIEN

 +22                               SET DA(2)=FACIEN

 +23                               SET DA(1)=FILEIEN

 +24                               SET DIE="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"

 +25                               SET DR=.02

 +26                               SET DR(2,9009061.11)=.01

 +27                               SET DR(3,9009061.1101)=.02

 +28                               SET DIE("NO^")="OUTOK"

 +29                               DO ^DIE

 +30      ;

 +31      ;Special code for Print Ethnicity On FaceSheet - AG*7.1*9

 +32                               IF FILENUM=2

                                       IF FIELDNAM="ETHNICITY INFORMATION"

                                           Begin DoDot:4

 +33                                           KILL DA,DR,DIE

 +34                                           SET DA=FACIEN

 +35                                           SET DIE="^AGFAC("

 +36                                           SET DR=501

 +37                                           DO ^DIE

 +38                                           KILL DA,DR,DIE

                                           End DoDot:4

                                           QUIT 

 +39      ;

 +40      ;Special code for Print Race On FaceSheet - AG*7.1*9

 +41                               IF FILENUM=2

                                       IF FIELDNAM="RACE"

                                           Begin DoDot:4

 +42                                           KILL DA,DR,DIE

 +43                                           SET DA=FACIEN

 +44                                           SET DIE="^AGFAC("

 +45                                           SET DR=503

 +46                                           DO ^DIE

 +47                                           KILL DA,DR,DIE

                                           End DoDot:4

                                           QUIT 

                               End DoDot:3

                               IF $DATA(Y)

                                   QUIT 

                       End DoDot:2

                       IF $DATA(Y)

                           QUIT 

               End DoDot:1

               IF $DATA(Y)

                   QUIT 

 +48       QUIT 

RESTRICT(IEN) ;EP - RESTRICT FILE CHOICE TO PATIENT REG FILES OR

 +1       ;SPECIFIC AUP,AUT FILES

 +2        QUIT 0

 +3       ;

 +4       ;AG*7.1*9 - Special check for mandatory multiple subfields

ALTREQ(FILENUM,FIELDNM) ;EP - ALTERNATE CHECK FOR SITE SPECIFIC MANDATORY FIELDS (HANDLES MULTIPLE SUBFIELDS)

 +1       ;^AGFAC Structure does not allow multiple subfields to be entered so the are entered for the parent file

 +2       ;This call will look up the multiple subfield by its name

 +3        NEW FLIEN,FDIEN

 +4        SET FLIEN=$ORDER(^AGFAC(DUZ(2),11,"B",FILENUM,""))

           IF FLIEN=""

               QUIT 0

 +5        SET FDIEN=$ORDER(^AGFAC(DUZ(2),11,FLIEN,1,"B",FIELDNM,""))

           IF FDIEN=""

               QUIT 0

 +6        QUIT $PIECE($GET(^AGFAC(DUZ(2),11,FLIEN,1,FDIEN,0)),U,2)