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

DGPFLMA1.m

Go to the documentation of this file.
  1. DGPFLMA1 ;ALB/KCL - PRF ASSIGNMENT LM PROTOCOL ACTIONS ; 6/10/03 3:57pm
  1. ;;5.3;Registration;**425**;Aug 13, 1993
  1. ;
  1. ;no direct entry
  1. QUIT
  1. ;
  1. SP ;Entry point for DGPF SELECT PATIENT action protocol.
  1. ;
  1. ; Input: None
  1. ;
  1. ; Output:
  1. ; DGDFN - pointer to patient in PATIENT #2 file
  1. ; VALMBCK - 'R' = refresh screen
  1. ;
  1. N DGPAT ;patient lookup array
  1. ;
  1. ;set screen to full scrolling region
  1. D FULL^VALM1
  1. ;
  1. ;patient selection (lookup)
  1. D SELPAT^DGPFUT1(.DGPAT)
  1. I (+$G(DGPAT)>0) D
  1. . S DGDFN=+DGPAT
  1. . ;
  1. . Q:'$$CONTINUE^DGPFUT()
  1. . ;
  1. . ;- build header for selected patient
  1. . D BLDHDR^DGPFLMU(DGDFN,.VALMHDR)
  1. . ;
  1. . ;- build list of flag assignments for selected patient
  1. . D BLDLIST^DGPFLMU(DGDFN)
  1. ;
  1. ;return to LM (refresh screen)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. ;
  1. DF ;Entry point for DGPF DISPLAY ASSIGNMENT DETAIL action protocol.
  1. ;
  1. ; Input: None
  1. ;
  1. ; Output:
  1. ; VALMBCK - 'R' = refresh screen
  1. ;
  1. N DGDFN ;patient dfn
  1. N DGIEN ;assignment ien
  1. N SEL ;user selection
  1. N VALMY ;output of EN^VALM2 call, array of user selected entries
  1. ;
  1. ;set screen to full scroll region
  1. D FULL^VALM1
  1. ;
  1. ;is action selection allowed?
  1. I '$D(@VALMAR@("IDX")) D Q
  1. . W !!?2,">>> '"_$P($G(XQORNOD(0)),U,3)_"' action not allowed at this point.",*7
  1. . I '$G(DGDFN) W !?6,"A patient has not been selected."
  1. . E W !?6,"There are no record flag assignments for this patient."
  1. . D PAUSE^VALM1
  1. . S VALMBCK="R"
  1. ;
  1. ;ask user to select a single assignment for detail display
  1. S (SEL,DGIEN,VALMBCK)=""
  1. D EN^VALM2($G(XQORNOD(0)),"S")
  1. ;
  1. ;process user selection
  1. S SEL=$O(VALMY(""))
  1. I SEL,$D(@VALMAR@("IDX",SEL,SEL)) D
  1. . S DGIEN=$P($G(@VALMAR@("IDX",SEL,SEL)),U)
  1. . S DGDFN=$P($G(@VALMAR@("IDX",SEL,SEL)),U,2)
  1. . ;-display flag assignment details
  1. . N VALMHDR
  1. . D EN^DGPFLMAD
  1. ;
  1. ;return to LM (refresh screen)
  1. S VALMBCK="R"
  1. Q