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

DGPFRAL.m

Go to the documentation of this file. 
  1. DGPFRAL ;ALB/RBS - PRF ACTION NOT LINKED REPORT ; 7/26/05 3:18pm
  1.  ;;5.3;Registration;**554,960**;Aug 13, 1993;Build 22
  1.  ;     Last Edited: SHRPE/SGM - Jun 29,2018 15:14
  1.  ;
  1.  ; ICR# TYPE DESCRIIPTION
  1.  ;----- ---- ----------------------------
  1.  ; 1519 Sup  EN^XUTMDEVQ
  1.  ;10006 Sup  ^DIC
  1.  ;10086 Sup  HOME^%ZIS
  1.  ;
  1.  ;This routine will be used for selecting sort parameters to produce
  1.  ;the DGPF ACTION NOT LINKED REPORT for Patient Record Flags.
  1.  ;
  1.  ; Selection options will provide the ability to report by:
  1.  ;  CATEGORY
  1.  ;  BEGINNING DATE
  1.  ;  ENDING DATE
  1.  ;
  1.  ; The following reporting sort array will be built by user prompts:
  1.  ;  DGSORT("DGCAT") = 1^Category I (National)
  1.  ;                    2^Category II (Local)
  1.  ;                    3^Both
  1.  ;  DGSORT("DGBEG") = BEGINNING DATE  (internal FileMan date)
  1.  ;  DGSORT("DGEND") = ENDING DATE     (internal FileMan date)
  1.  ;  DGSORT("DGFAC") = 1^Local Facility Only
  1.  ;                    2^Other Facilities
  1.  ;                    3^Both
  1.  ;  DGSORT("DGFLG") = "" for all flags
  1.  ;                    Else pointer^name^variable_pointer
  1.  ;  DGSORT("DGSTA") = 0^Inactive
  1.  ;                    1^Active
  1.  ;                    2^Both
  1.  ;
  1.  ;-- no direct entry
  1.  QUIT
  1.  ;
  1. EN ;Entry point
  1.  ;-- user prompts for report selection sorts
  1.  ;   DG*5.3*960 - $$FLAGONE, $$STATUS, $$TYPE 
  1.  ;  Input: none
  1.  ; Output: Report generated using user selected parameters
  1.  ;
  1.  N DGFIRST ;first assignment date
  1.  N DGSEL   ;help text var
  1.  N DGSORT  ;array or report parameters
  1.  N ZTSAVE  ;open array reference of input parameters used by tasking
  1.  N X,Y
  1.  ;
  1.  S DGFIRST=$P(+$O(^DGPF(26.14,"D","")),".")    ;first assignment date
  1.  I 'DGFIRST D  Q
  1.  . D E(">>> No Patient Record Flag Assignments have been found.")
  1.  . Q
  1.  ;-- prompt for selection of a flag category
  1.  I '$$FLAG Q  ;  Returns DGSORT("DGCAT")
  1.  ;
  1.  ;-- prompt for a single flag, else all flags
  1.  I $$FLAGONE<0 Q  ;      DGSORT("DGFLG")
  1.  ;
  1.  ;-- prompt for beginning date
  1.  W ! I '$$DATEBEG Q  ;       DGSORT("DGBEG")
  1.  ;
  1.  ;-- prompt for ending date
  1.  I '$$DATEEND Q  ;       DGSORT("DGEND")
  1.  ;
  1.  ;-- prompt for flag status
  1.  I '$$STATUS Q  ;        DGSORT("DGSTA")
  1.  ;
  1.  ;-- prompt for type of History records
  1.  I '$$TYPE Q  ;          DGSORT("DGFAC")
  1.  ;
  1.  ;-- prompt for device
  1.  S ZTSAVE("DGSORT(")=""
  1.  S X="Assignment Action Not Linked to a Progress Note Report"
  1.  D EN^XUTMDEVQ("START^DGPFRAL1",X,.ZTSAVE)
  1.  D HOME^%ZIS
  1.  Q
  1.  ;
  1.  ;-----------------------  PRIVATE SUBROUTINES  -----------------------
  1. HELP(DGSEL) ;provide extended DIR("?") help text.
  1.  ;
  1.  ;  Input: DGSEL - prompt var for help text word selection
  1.  ; Output: none
  1.  ;
  1.  N X S X=$S(DGSEL=1:"earliest",1:"latest")
  1.  W !,"  Enter "_X_" Assignment Action Date to include in the report."
  1.  W !,"  Please enter a date from the specified date range displayed."
  1.  Q
  1.  ;
  1. E(TX) ;  press ENTER to continue prompt
  1.  I $L(TX) W !?2,TX_$C(7)
  1.  I $$ANSWER^DGPFUT("Enter RETURN to continue","","E")
  1.  Q
  1.  ;
  1. DATEBEG() ;-- prompt for beginning date
  1.  N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO
  1.  S DGDIRA="Select Beginning Date"
  1.  S DGDIRB=""
  1.  S DGDIRH="^D HELP^DGPFRAL(1)"
  1.  S DGDIRO="D^"_DGFIRST_":DT:EX"
  1.  S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
  1.  I DGASK>0 S DGSORT("DGBEG")=DGASK
  1.  Q DGASK>0
  1.  ;
  1. DATEEND() ;-- prompt for ending date
  1.  N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO
  1.  S DGDIRA="Select Ending Date"
  1.  S DGDIRB=""
  1.  S DGDIRH="^D HELP^DGPFRAL(2)"
  1.  S DGDIRO="D^"_DGSORT("DGBEG")_":DT:EX"
  1.  S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
  1.  I DGASK>0 S DGSORT("DGEND")=DGASK
  1.  Q DGASK>0
  1.  ;
  1. FLAG() ;-- prompt for selection of a flag category
  1.  ;;1:Category I (National);2:Category II (Local);3:Both (Category I & II)
  1.  N DGASK,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^"_$P($T(FLAG+1),";",3,9)
  1.  S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
  1.  I DGASK>0 S DGSORT("DGCAT")=$$PIECE(DGDIRO,DGASK)
  1.  Q DGASK>0
  1.  ;
  1.  ;--- start code addition by DG*5.3*960
  1. FLAGONE() ;-- prompt for a single flag
  1.  ;;
  1.  ;;Press [ENTER] to run report for all flags
  1.  ;;Select a single flag name for the report
  1.  ;;Enter '^' to exit back to your primary menu
  1.  ;;
  1.  N I,X,Y,Z,CAT,DIC,DTOUT,DUOUT
  1.  S DGSORT("DGFLG")=""
  1.  S CAT=+DGSORT("DGCAT") I CAT'=1,CAT'=2 Q 1
  1.  F I=1:1:5 W !,$TR($T(FLAGONE+I),";"," ")
  1.  S DIC=$P("26.15^26.11",U,CAT)
  1.  S DIC(0)="QAEM"
  1.  S DIC("A")="Select Category "_$E("II",1,CAT)_" Flag: "
  1.  D ^DIC W !
  1.  I Y>0 S DGSORT("DGFLG")=Y_U_(+Y)_";"_$P(DIC,U,2)
  1.  Q Y>0
  1.  ;
  1. STATUS() ;-- prompt for flag status
  1.  N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO
  1.  S DGDIRA="Choose Flag Status"
  1.  S DGDIRB=""
  1.  S DGDIRH="Enter which statuses to report on"
  1.  S DGDIRO="S^1:Inactive;2:Active;3:Both active and inactive"
  1.  S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
  1.  I DGASK>0 S DGSORT("DGSTA")=$$PIECE(DGDIRO,DGASK)
  1.  Q DGASK>0
  1.  ;
  1. TYPE() ;-- prompt for type of history records
  1.  I +DGSORT("DGCAT")=2 S DGSORT("DGFAC")="1^Local Facility" Q 1
  1.  ;
  1.  N X,DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO
  1.  S DGDIRA="Choose Type of History Record"
  1.  S DGDIRB=""
  1.  S DGDIRH="^D TYPEH^DGPFRAL"
  1.  S X="S^1:Actions performed by local facility only;"
  1.  S X=X_"2:Actions performed by other facilities;"
  1.  S X=X_"3:Actions performed by all facilities"
  1.  S DGDIRO=X
  1.  S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH) I DGASK>0 D
  1.  . S X=$P("Local Facility^Other Facilities^All Facilities",U,DGASK)
  1.  . S DGSORT("DGFAC")=DGASK_U_X
  1.  . Q
  1.  Q DGASK>0
  1.  ;
  1. TYPEH ;  provide extended DIR("?") help for facility type
  1.  ;;Enter the type of History Action records to display:
  1.  ;;
  1.  ;;    Local: records created by this VAMC
  1.  ;;    Other: records created by other VAMCs, not this VAMC
  1.  ;;     Both: means to show all history records with no regard
  1.  ;;           for the facility that created them
  1.  ;;
  1.  N I F I=1:1:7 W !,$TR($T(HELPT+I),";"," ")
  1.  Q
  1.  ;
  1. PIECE(DGIR0,DGASK) ;
  1.  N X
  1.  S X=$P(DGIR0,U,2)
  1.  S X=$P(X,";",DGASK)
  1.  S X=$P(X,":",2)
  1.  Q DGASK_U_X