Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPFUT7

DGPFUT7.m

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