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)
