DGPFUT7 ;ALB/RBS - PRF COMMON PROMPTS ; 05/11/2018 10:00
;;5.3;Registration;**960**;Aug 13, 1993;Build 22
; Last Edited: SHRPE/sgm - May 29, 2018 17:14
;
; ICR# TYPE DESCRIPTION
;----- ---- ------------------------------------
; 2050 Sup MSG^DIALOG
; 2055 Sup $$EXTERNAL^DILFD
;
;This routine contains common prompts asked in various DGPF routines.
;DATA - checks to see if any assignments exist for a flag
;
Q
;
CAT() ; ----- prompt for Category I, II, Both
; RETURN: -1 or 1^Catetory I (National)
; 2^Category II (Local)
; 3^Category I & II
N X,Y,ANS,DGDIRA,DGDIRB,DGDIRH,DGDIRO
S DGDIRA="Select Flag Category"
S DGDIRB=""
S DGDIRH="Enter one of the category selections to report on"
S DGDIRO="S^1:Category I (National);2:Category II (Local);3:Both"
S ANS=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
S X="Category I (National)^Category II (Local)^Category I & II"
S Y=$S(ANS<1:-1,1:ANS_U_$P(X,U,ANS))
Q Y
;
DATA() ; ----- check for any flag assignment
;check for database for first assignment date
N X S X=$P(+$O(^DGPF(26.14,"D","")),".") I X Q X
S X=" >>> No Patient Record Flag Assignments have been found."
N MSG S MSG("DIMSG",1)=X D DIALOG(,"MSG")
Q $$E
;
DIALOG(FLAG,INPUT) ;
; .INPUT - required - passed by reference
N DTOUT,DUOUT
S FLAG=$G(FLAG) S:FLAG="" FLAG="MW"
I $G(INPUT)="" S INPUT="INPUT"
D MSG^DIALOG(FLAG,,,,"INPUT")
Q
;
E(MSG) ; ----- ask user to press enter to continue
; Return: -2:Time-out; -1:'^'-out 1:anything else
S MSG=$G(MSG)
N X,Y,Z,DIR,DIROUT,DIRUT,DTOUT,DUOUT
S DIR(0)="E"
I $L(MSG) S DIR("A")=MSG
D ^DIR
S X=$S($D(DTOUT):-2,$D(DUOUT):-1,1:1)
Q X
;
FLAG() ; ----- prompt for All or Select Flag
; RETURN: -1 or A:All Flags or S:Single Flag
N X,Y,ANS,DGDIRA,DGDIRB,DGDIRH,DGDIRO
S DGDIRA="Select to report on a (S)ingle flag or (A)ll flags"
S DGDIRB="Single Flag"
S DGDIRO="S^S:Single Flag;A:All Flags"
S DGDIRH="Enter one of the flag selections to report on"
S ANS=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
I $L(ANS) S X=ANS_U_$S(ANS="S":"Single Flag",ANS="A":"All Flags",1:"")
S Y=$S('$L(ANS):-1,"AS"'[ANS:-1,1:X)
Q Y
;
ONEFLAG(CAT,VALID) ; ----- prompt for name of flag
; INPUT PARAMETERS:
; CAT - optional - I:National Flag II:Local Flag
; default to I
; VALID - optional - 1:verify at least one assignment
; 0:do not verify any current assignments
; default to 1
; RETURN: -1 or
; 0 if no flag assignments found
; variable_pointer^flagname
;
N X,Y,ANS,DGDIRA,DGDIRB,DGDIRH,DGDIRO,DGFILE,FLAG,RET
S CAT=$G(CAT) I CAT'="I",CAT'="II" S CAT="I"
I CAT="I" S DGFILE=26.15
I CAT="II" S DGFILE=26.11
S VALID=$G(VALID) I VALID'=0,VALID'=1 S VALID=1
S DGDIRA="Select Record Flag Name"
S DGDIRB=""
S DGDIRO="P^"_DGFILE_",.01:EMZ"
S ANS=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO)
I ANS<1 Q -1
S ANS=ANS_";DGPF("_DGFILE_","
;
S FLAG=$$EXTERNAL^DILFD(26.13,.02,"F",ANS)
S RET=ANS_U_FLAG
I 'VALID Q RET
;
; see if there is at least one assignment
I $$ASGNCNT^DGPFLF6(ANS) Q RET
;
W !," >>> No Patient Record Flag Assignments have been found."
Q 0
;
OWNACT() ; -- prompt for local/not local ownership of assignment action
; Use this for testing ^DD(26.14) ownership
; RETURN: -1 or 1:Local Facility
; 2:Other Facilities
; 3:All Facilities
N X,Y,ANS,DGDIRA,DGDIRB,DGDIRH,DGDIRO
S DGDIRA="Select Ownership Type"
S DGDIRB=""
S DGDIRH="Local means this facility generated the PRF History action record"
S DGDIRO="S^1:Local Facility Only;2:Other Facilities;3:All Facilities"
S ANS=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
S X="Local Facility^Other Facilities^All Facilities"
S Y=$S(ANS<1:-1,1:ANS_U_$P(X,U,ANS))
Q Y
;
OWNASGN() ; ----- prompt for local/not local ownership of assignment
; Use for testing ^DD(26.13,.04) OWNER SITE
; RETURN: -1 or 1:Local Facility
; 2:Other Facilities
; 3:All Facilities
N X,Y,ANS,DGDIRA,DGDIRB,DGDIRH,DGDIRO
S DGDIRA="Select Ownership Type"
S DGDIRB=""
S DGDIRH="Local means the PRF assignment is owned by this facility"
S DGDIRO="S^1:Local Facility Only;2:Other Facilities;3:All Facilities"
S ANS=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
S X="Local Facility^Other Facilities^All Facilities"
S Y=$S(ANS<1:-1,1:ANS_U_$P(X,U,ANS))
Q Y
;
STATUS(BOTH) ; ----- prompt for assignment status
; INPUT PARAMETER: Both - optional, default to 1
; 1:include both as a choice; 0:do not include both
; Used for asking ^DD(26.13,.03) STATUS
; RETURN: -1 or 1^Active
; 2:^Inactive
; 3^Both Active & Inactive
N X,Y,ANS,DGDIRA,DGDIRB,DGDIRH,DGDIRO
S BOTH=$G(BOTH) I 10'[$E(BOTH) S BOTH=1
S DGDIRA="Select Current Assignment Status"
S DGDIRB=""
S DGDIRH="Enter the current assignment Status to be in the report"
S DGDIRO="S^1:Active;2:Inactive" S:BOTH DGDIRO=DGDIRO_";3:Both"
S ANS=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
S X="Active^Inactive^Both Active & Inactive"
S Y=$S(ANS<1:-1,1:ANS_U_$P(X,U,ANS))
Q Y
;
; Prompts for Asking Date Range
START(BEG,END) ; ----- prompt for starting date
; INPUT PARAMTERS:
; BEG - optional - earliest date allowed
; END - optional - latest date allowed
; default to DT
; RETURN: -1 or Fileman date
N X,Y,ANS,DGDIRA,DGDIRB,DGDIRH,DGDIRO
S DGDIRA="Select Beginning Date"
S DGDIRB=""
S DGDIRH="^D HELP^DGPFUT7(1)"
S X=$G(BEG)_":"_$S(+$G(END):END,1:DT)
S DGDIRO="D^"_X_":EX"
S ANS=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
S X=$S(ANS<1:-1,1:ANS)
Q X
;
END(BEG,END) ; ----- prompt for ending date
; INPUT PARAMTERS:
; BEG - optional - earliest date allowed
; END - optional - latest date allowed
; default to DT
; RETURN: -1 or Fileman date
N X,Y,ANS,DGDIRA,DGDIRB,DGDIRH,DGDIRO
S DGDIRA="Select Ending Date"
S DGDIRB=""
S DGDIRH="^D HELP^DGPFUT7(2)"
S X=$G(BEG)_":"_$S(+$G(END):END,1:DT)
S DGDIRO="D^"_X_":EX"
S ANS=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
S X=$S(ANS<1:-1,1:ANS)
Q X
;
HELP(DGPF) ;provide extended DIR("?") help text.
;
; Input: DGSEL - prompt var for help text word selection
; Output: none
;
N A,T,MSG
S DGPF=$G(DGPF) S:DGPF="" DGPF=1 S DGPF=(DGPF=1)
S T=$P("latest^earliest",U,DGPF+1)
S A=" Enter the "_T_" Assignment Date to include in the report."
S MSG("DIMSG",1)=A
S A=" Please enter a date from the specified date range displayed."
S MSG("DIMSG",2)=A
D DIALOG(,"MSG")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFUT7 6801 printed Apr 09, 2024@21:51:41 Page 2
DGPFUT7 ;ALB/RBS - PRF COMMON PROMPTS ; 05/11/2018 10:00
+1 ;;5.3;Registration;**960**;Aug 13, 1993;Build 22
+2 ; Last Edited: SHRPE/sgm - May 29, 2018 17:14
+3 ;
+4 ; ICR# TYPE DESCRIPTION
+5 ;----- ---- ------------------------------------
+6 ; 2050 Sup MSG^DIALOG
+7 ; 2055 Sup $$EXTERNAL^DILFD
+8 ;
+9 ;This routine contains common prompts asked in various DGPF routines.
+10 ;DATA - checks to see if any assignments exist for a flag
+11 ;
+12 QUIT
+13 ;
CAT() ; ----- prompt for Category I, II, Both
+1 ; RETURN: -1 or 1^Catetory I (National)
+2 ; 2^Category II (Local)
+3 ; 3^Category I & II
+4 NEW X,Y,ANS,DGDIRA,DGDIRB,DGDIRH,DGDIRO
+5 SET DGDIRA="Select Flag Category"
+6 SET DGDIRB=""
+7 SET DGDIRH="Enter one of the category selections to report on"
+8 SET DGDIRO="S^1:Category I (National);2:Category II (Local);3:Both"
+9 SET ANS=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+10 SET X="Category I (National)^Category II (Local)^Category I & II"
+11 SET Y=$SELECT(ANS<1:-1,1:ANS_U_$PIECE(X,U,ANS))
+12 QUIT Y
+13 ;
DATA() ; ----- check for any flag assignment
+1 ;check for database for first assignment date
+2 NEW X
SET X=$PIECE(+$ORDER(^DGPF(26.14,"D","")),".")
IF X
QUIT X
+3 SET X=" >>> No Patient Record Flag Assignments have been found."
+4 NEW MSG
SET MSG("DIMSG",1)=X
DO DIALOG(,"MSG")
+5 QUIT $$E
+6 ;
DIALOG(FLAG,INPUT) ;
+1 ; .INPUT - required - passed by reference
+2 NEW DTOUT,DUOUT
+3 SET FLAG=$GET(FLAG)
if FLAG=""
SET FLAG="MW"
+4 IF $GET(INPUT)=""
SET INPUT="INPUT"
+5 DO MSG^DIALOG(FLAG,,,,"INPUT")
+6 QUIT
+7 ;
E(MSG) ; ----- ask user to press enter to continue
+1 ; Return: -2:Time-out; -1:'^'-out 1:anything else
+2 SET MSG=$GET(MSG)
+3 NEW X,Y,Z,DIR,DIROUT,DIRUT,DTOUT,DUOUT
+4 SET DIR(0)="E"
+5 IF $LENGTH(MSG)
SET DIR("A")=MSG
+6 DO ^DIR
+7 SET X=$SELECT($DATA(DTOUT):-2,$DATA(DUOUT):-1,1:1)
+8 QUIT X
+9 ;
FLAG() ; ----- prompt for All or Select Flag
+1 ; RETURN: -1 or A:All Flags or S:Single Flag
+2 NEW X,Y,ANS,DGDIRA,DGDIRB,DGDIRH,DGDIRO
+3 SET DGDIRA="Select to report on a (S)ingle flag or (A)ll flags"
+4 SET DGDIRB="Single Flag"
+5 SET DGDIRO="S^S:Single Flag;A:All Flags"
+6 SET DGDIRH="Enter one of the flag selections to report on"
+7 SET ANS=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+8 IF $LENGTH(ANS)
SET X=ANS_U_$SELECT(ANS="S":"Single Flag",ANS="A":"All Flags",1:"")
+9 SET Y=$SELECT('$LENGTH(ANS):-1,"AS"'[ANS:-1,1:X)
+10 QUIT Y
+11 ;
ONEFLAG(CAT,VALID) ; ----- prompt for name of flag
+1 ; INPUT PARAMETERS:
+2 ; CAT - optional - I:National Flag II:Local Flag
+3 ; default to I
+4 ; VALID - optional - 1:verify at least one assignment
+5 ; 0:do not verify any current assignments
+6 ; default to 1
+7 ; RETURN: -1 or
+8 ; 0 if no flag assignments found
+9 ; variable_pointer^flagname
+10 ;
+11 NEW X,Y,ANS,DGDIRA,DGDIRB,DGDIRH,DGDIRO,DGFILE,FLAG,RET
+12 SET CAT=$GET(CAT)
IF CAT'="I"
IF CAT'="II"
SET CAT="I"
+13 IF CAT="I"
SET DGFILE=26.15
+14 IF CAT="II"
SET DGFILE=26.11
+15 SET VALID=$GET(VALID)
IF VALID'=0
IF VALID'=1
SET VALID=1
+16 SET DGDIRA="Select Record Flag Name"
+17 SET DGDIRB=""
+18 SET DGDIRO="P^"_DGFILE_",.01:EMZ"
+19 SET ANS=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO)
+20 IF ANS<1
QUIT -1
+21 SET ANS=ANS_";DGPF("_DGFILE_","
+22 ;
+23 SET FLAG=$$EXTERNAL^DILFD(26.13,.02,"F",ANS)
+24 SET RET=ANS_U_FLAG
+25 IF 'VALID
QUIT RET
+26 ;
+27 ; see if there is at least one assignment
+28 IF $$ASGNCNT^DGPFLF6(ANS)
QUIT RET
+29 ;
+30 WRITE !," >>> No Patient Record Flag Assignments have been found."
+31 QUIT 0
+32 ;
OWNACT() ; -- prompt for local/not local ownership of assignment action
+1 ; Use this for testing ^DD(26.14) ownership
+2 ; RETURN: -1 or 1:Local Facility
+3 ; 2:Other Facilities
+4 ; 3:All Facilities
+5 NEW X,Y,ANS,DGDIRA,DGDIRB,DGDIRH,DGDIRO
+6 SET DGDIRA="Select Ownership Type"
+7 SET DGDIRB=""
+8 SET DGDIRH="Local means this facility generated the PRF History action record"
+9 SET DGDIRO="S^1:Local Facility Only;2:Other Facilities;3:All Facilities"
+10 SET ANS=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+11 SET X="Local Facility^Other Facilities^All Facilities"
+12 SET Y=$SELECT(ANS<1:-1,1:ANS_U_$PIECE(X,U,ANS))
+13 QUIT Y
+14 ;
OWNASGN() ; ----- prompt for local/not local ownership of assignment
+1 ; Use for testing ^DD(26.13,.04) OWNER SITE
+2 ; RETURN: -1 or 1:Local Facility
+3 ; 2:Other Facilities
+4 ; 3:All Facilities
+5 NEW X,Y,ANS,DGDIRA,DGDIRB,DGDIRH,DGDIRO
+6 SET DGDIRA="Select Ownership Type"
+7 SET DGDIRB=""
+8 SET DGDIRH="Local means the PRF assignment is owned by this facility"
+9 SET DGDIRO="S^1:Local Facility Only;2:Other Facilities;3:All Facilities"
+10 SET ANS=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+11 SET X="Local Facility^Other Facilities^All Facilities"
+12 SET Y=$SELECT(ANS<1:-1,1:ANS_U_$PIECE(X,U,ANS))
+13 QUIT Y
+14 ;
STATUS(BOTH) ; ----- prompt for assignment status
+1 ; INPUT PARAMETER: Both - optional, default to 1
+2 ; 1:include both as a choice; 0:do not include both
+3 ; Used for asking ^DD(26.13,.03) STATUS
+4 ; RETURN: -1 or 1^Active
+5 ; 2:^Inactive
+6 ; 3^Both Active & Inactive
+7 NEW X,Y,ANS,DGDIRA,DGDIRB,DGDIRH,DGDIRO
+8 SET BOTH=$GET(BOTH)
IF 10'[$EXTRACT(BOTH)
SET BOTH=1
+9 SET DGDIRA="Select Current Assignment Status"
+10 SET DGDIRB=""
+11 SET DGDIRH="Enter the current assignment Status to be in the report"
+12 SET DGDIRO="S^1:Active;2:Inactive"
if BOTH
SET DGDIRO=DGDIRO_";3:Both"
+13 SET ANS=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+14 SET X="Active^Inactive^Both Active & Inactive"
+15 SET Y=$SELECT(ANS<1:-1,1:ANS_U_$PIECE(X,U,ANS))
+16 QUIT Y
+17 ;
+18 ; Prompts for Asking Date Range
START(BEG,END) ; ----- prompt for starting date
+1 ; INPUT PARAMTERS:
+2 ; BEG - optional - earliest date allowed
+3 ; END - optional - latest date allowed
+4 ; default to DT
+5 ; RETURN: -1 or Fileman date
+6 NEW X,Y,ANS,DGDIRA,DGDIRB,DGDIRH,DGDIRO
+7 SET DGDIRA="Select Beginning Date"
+8 SET DGDIRB=""
+9 SET DGDIRH="^D HELP^DGPFUT7(1)"
+10 SET X=$GET(BEG)_":"_$SELECT(+$GET(END):END,1:DT)
+11 SET DGDIRO="D^"_X_":EX"
+12 SET ANS=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+13 SET X=$SELECT(ANS<1:-1,1:ANS)
+14 QUIT X
+15 ;
END(BEG,END) ; ----- prompt for ending date
+1 ; INPUT PARAMTERS:
+2 ; BEG - optional - earliest date allowed
+3 ; END - optional - latest date allowed
+4 ; default to DT
+5 ; RETURN: -1 or Fileman date
+6 NEW X,Y,ANS,DGDIRA,DGDIRB,DGDIRH,DGDIRO
+7 SET DGDIRA="Select Ending Date"
+8 SET DGDIRB=""
+9 SET DGDIRH="^D HELP^DGPFUT7(2)"
+10 SET X=$GET(BEG)_":"_$SELECT(+$GET(END):END,1:DT)
+11 SET DGDIRO="D^"_X_":EX"
+12 SET ANS=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+13 SET X=$SELECT(ANS<1:-1,1:ANS)
+14 QUIT X
+15 ;
HELP(DGPF) ;provide extended DIR("?") help text.
+1 ;
+2 ; Input: DGSEL - prompt var for help text word selection
+3 ; Output: none
+4 ;
+5 NEW A,T,MSG
+6 SET DGPF=$GET(DGPF)
if DGPF=""
SET DGPF=1
SET DGPF=(DGPF=1)
+7 SET T=$PIECE("latest^earliest",U,DGPF+1)
+8 SET A=" Enter the "_T_" Assignment Date to include in the report."
+9 SET MSG("DIMSG",1)=A
+10 SET A=" Please enter a date from the specified date range displayed."
+11 SET MSG("DIMSG",2)=A
+12 DO DIALOG(,"MSG")
+13 QUIT
