- 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 Feb 19, 2025@00:15:01 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