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

DGPFLF3.m

Go to the documentation of this file. 
  1. DGPFLF3 ;ALB/RBS - PRF FLAG MANAGEMENT LM PROTOCOL ACTIONS CONT. ; 6/9/04 2:05pm
  1.  ;;5.3;Registration;**425,554,650,1015**;Aug 13, 1993 ;Build 21
  1.  ;
  1.  ;no direct entry
  1.  QUIT
  1.  ;
  1.  ;
  1. AF ;Entry point for DGPF ADD FLAG action protocol.
  1.  ;
  1.  ;  Input: DGCAT - flag category (1=National, 2=Local)
  1.  ;
  1.  ; Output: New File entry in PRF LOCAL FLAG FILE (#26.11)
  1.  ;         New File entry in PRF LOCAL FLAG HISTORY FILE (#26.12)
  1.  ;         Set variable VALMBCK to 'R' = refresh screen
  1.  ;
  1.  N DIC,DGWPROOT,DIWETXT,DIWESUB,DWLW,DWPK ;input vars for EN^DIWE call
  1.  N DGASK    ;return value from call to ^DIR - $$ANSWER^DGPFUT call
  1.  N DGCKWP   ;check if word-processing is OK
  1.  N DGPFLF   ;array containing flag record field values
  1.  N DGPFLH   ;array containing flag history record field values
  1.  N DGABORT  ;abort flag
  1.  N DGRESULT ;result of $$STOALL^DGPFALF1 api call
  1.  N DGRDAY   ;review frequency var
  1.  N DGNDAY   ;notification days var
  1.  N DGERR    ;if error returned
  1.  N DGOK     ;ok flag to enter record flag entry & flag description
  1.  N DGMSG    ;user message
  1.  N DGQ      ;quit flag
  1.  ;
  1.  ;init vars
  1.  S DGOK=1,(DGQ,DGABORT)=0
  1.  ;
  1.  ;set screen to full scrolling region
  1.  D FULL^VALM1
  1.  W !
  1.  ;
  1.  ;check flag category (only Category II flags can be created)
  1.  I DGCAT=1 D
  1.  . D BLD^DIALOG(261129,"Can not add 'Category I' flags.","","DGERR","F")
  1.  . D MSG^DIALOG("WE","","","","DGERR") W *7
  1.  . D PAUSE^VALM1
  1.  . S DGOK=0
  1.  ;
  1.  ;user prompts
  1.  D:DGOK
  1.  . ;-- init flag record and history arrays
  1.  . ;   The DGPFLF array will contain 2 "^" pieces (internal^external)
  1.  . ;   for a final full screen display before filing.
  1.  . K DGPFLF,DGPFLH
  1.  . ;
  1.  . ;-- prompt for flag name, quit if one not entered
  1.  . S DGASK=$$ANSWER^DGPFUT("Enter the Record Flag Name","","26.11,.01^^I $D(^DGPF(26.11,""B"",X)) K X W "" *** Flag name already on file""")
  1.  . I DGASK=-1!(DGASK=0) S DGABORT=1 Q
  1.  . S DGPFLF("FLAG")=DGASK_U_DGASK
  1.  . ;
  1.  . ;-- prompt for status of the flag, quit if one not entered
  1.  . S DGASK=$$ANSWER^DGPFUT("Enter the Status of the Flag","ACTIVE","26.11,.02")
  1.  . I DGASK<0 S DGABORT=1 Q
  1.  . S DGPFLF("STAT")=DGASK_U_$$EXTERNAL^DILFD(26.11,.02,"F",DGASK)
  1.  . ;
  1.  . ;-- prompt for flag type, quit if one not entered
  1.  . S DGASK=$$ANSWER^DGPFUT("Enter the Type of the Flag","","26.11,.03")
  1.  . I DGASK'>0 S DGABORT=1 Q
  1.  . S DGPFLF("TYPE")=DGASK_U_$$EXTERNAL^DILFD(26.11,.03,"F",DGASK)
  1.  . ;
  1.  . ;-- prompt for principal investigator(s) name for RESEARCH flag type 
  1.  . I +DGPFLF("TYPE")=2,'$$PRININV^DGPFLF6(0,.DGPFLF) D  Q:DGABORT
  1.  . . I $$ANSWER^DGPFUT("Enter RETURN to continue or '^' to exit","","E")=-1 S DGABORT=1
  1.  . ;
  1.  . ;-- prompt for review frequency, quit if user aborts
  1.  . S DGASK=$$ANSWER^DGPFUT("Enter the Review Frequency Days","","26.11,.04^^K:$L(X)>4!(X[""."") X")
  1.  . I DGASK<0 S DGABORT=1 Q
  1.  . S DGPFLF("REVFREQ")=DGASK_U_DGASK
  1.  . S DGRDAY=DGASK
  1.  . I DGASK=0 D
  1.  . . ;-- if review frequency=0, don't ask notification/review group
  1.  . . ;   reset both fields
  1.  . . S DGPFLF("NOTIDAYS")=0_U_0
  1.  . . S DGPFLF("REVGRP")=""_U_""
  1.  . . ;
  1.  . E  D  Q:DGABORT    ;continue to prompt user and check abort logic
  1.  . . ;
  1.  . . ;-- prompt for notification days
  1.  . . S DGASK=$$ANSWER^DGPFUT("Enter the Notification Days","","26.11,.05^^K:$L(X)>4!(X[""."")!(X>DGRDAY) X")
  1.  . . I DGASK<0 S DGABORT=1 Q
  1.  . . S DGPFLF("NOTIDAYS")=DGASK_U_DGASK
  1.  . . ;
  1.  . . S DGQ=0
  1.  . . F  D  Q:(DGQ!DGABORT)
  1.  . . . ;-- prompt for review mail group name, optional entry
  1.  . . . S DGASK=$$ANSWER^DGPFUT("Enter the Review Mail Group","","26.11,.06")
  1.  . . . I DGASK<0 S DGABORT=1 Q
  1.  . . . I DGASK'>0 D  Q
  1.  . . . . W !,"   >>> You've entered the Review Frequency and Notification Days,"
  1.  . . . . W !,"       now enter a Review Mail Group or abort this process.",*7
  1.  . . . . I '$$CONTINUE^DGPFUT() S DGABORT=1
  1.  . . . ;
  1.  . . . S DGPFLF("REVGRP")=DGASK_U_$$EXTERNAL^DILFD(26.11,.06,"F",DGASK)
  1.  . . . S DGQ=1  ;set entry, quit
  1.  . ;
  1.  . ;-- prompt for associated TIU PN Title, quit if one not entered
  1.  . ; There is a DD screen on the (#.07) field - using IA #4380
  1.  . ; to only display Category II PN Titles not already associated
  1.  . ; with a Category II (Local) Record Flag name.
  1.  . ;
  1.  . S DGASK=$$ANSWER^DGPFUT("Enter the Progress Note Title","","26.11,.07")
  1.  . I DGASK<0 S DGABORT=1 Q
  1.  . S DGPFLF("TIUTITLE")=DGASK_U_$$EXTERNAL^DILFD(26.11,.07,"F",DGASK)
  1.  . ;
  1.  . ;-- have user enter flag description text (required)
  1.  . S DGCKWP=0
  1.  . S DGWPROOT=$NA(^TMP($J,"DGPFDESC"))
  1.  . K @DGWPROOT
  1.  . F  D  Q:(DGCKWP!DGABORT)
  1.  . . W !,"Enter the description for this new record flag:"  ;needed for line editor
  1.  . . S DIC=$$OREF^DILF(DGWPROOT)
  1.  . . S DIWETXT="Patient Record Flag - Flag Description Text"
  1.  . . S DIWESUB="Flag Description Text"
  1.  . . S DWLW=75 ;max # of chars allowed to be stored on WP global node
  1.  . . S DWPK=1  ;if line editor, don't join line
  1.  . . D EN^DIWE
  1.  . . I $$CKWP^DGPFUT(DGWPROOT) S DGCKWP=1 Q
  1.  . . W !,"Flag Description Text is required!",!,*7
  1.  . . I '$$CONTINUE^DGPFUT() S DGABORT=1
  1.  . ;
  1.  . ;-- quit if required flag description not entered
  1.  . Q:DGABORT
  1.  . ;
  1.  . ;-- place flag description text into assignment array
  1.  . M DGPFLF("DESC")=@DGWPROOT K @DGWPROOT
  1.  . ;
  1.  . ;-- setup remaining flag history array nodes for filing
  1.  . ;   note, the DGPFLH("FLAG") will be setup in $$STOALL^DGPFALF1
  1.  . S DGPFLH("ENTERDT")=$$NOW^XLFDT()   ;current date/time
  1.  . S DGPFLH("ENTERBY")=DUZ             ;current user
  1.  . S DGPFLH("REASON",1,0)="New Local Patient Record Flag entered."
  1.  . ;
  1.  . ;-- re-display user's answers on full screen
  1.  . D REVIEW^DGPFUT3(.DGPFLF,.DGPFLH,"",XQY0,XQORNOD(0))
  1.  . ;
  1.  . W !,*7
  1.  . I $$ANSWER^DGPFUT("Would you like to file this new local record flag","YES","Y")'>0 S DGABORT=1 Q
  1.  . ;
  1.  . W !,"Filing the new local record flag..."
  1.  . ;
  1.  . ;-- file both the (#26.11) & (#26.12) entries
  1.  . S DGRESULT=$$STOALL^DGPFALF1(.DGPFLF,.DGPFLH,.DGERR)
  1.  . ;
  1.  . W !!,"   >>> Local record flag was "_$S(+DGRESULT:"filed successfully.",1:"not filed successfully."),*7
  1.  . ;
  1.  . D PAUSE^VALM1
  1.  ;
  1.  I DGABORT D
  1.  . W !,"   >>> The '"_$P($G(XQORNOD(0)),U,3)_"' action is aborting, nothing has been filed.",*7
  1.  . I $$ANSWER^DGPFUT("Enter RETURN to continue","","E")  ;pause
  1.  ;
  1.  ;re-build list of local record flags
  1.  D BLD^DGPFLF
  1.  ;
  1.  ;return to LM (refresh screen)
  1.  S VALMBCK="R"
  1.  Q