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

DGPFLMQ1.m

Go to the documentation of this file. 
  1. DGPFLMQ1 ;ALB/RPM - PRF QUERY LISTMAN SCREEN BUILDER; 6/19/06
  1.  ;;5.3;Registration;**650,1015**;Aug 13, 1993;Build 21
  1.  ;
  1.  Q  ;no direct entry
  1.  ;
  1. BLDHDR(DGORF,DGPFHDR) ;build VALMHDR array
  1.  ;This procedure builds the VALMHDR array to display the ListMan header.
  1.  ;
  1.  ; Supported DBIA #2701: The supported DBIA is used to access the
  1.  ;                       MPI functions to retrieve the ICN and CMOR.
  1.  ;
  1.  ;  Input:
  1.  ;     DGORF - parsed ORF segments data array
  1.  ;   DGPFHDR - header array passed by reference
  1.  ;
  1.  ; Output:
  1.  ;   DGPFHDR - header array
  1.  ;
  1.  N DGDFN     ;pointer to patient in PATIENT (#2) file
  1.  N DGFACNAM  ;facility name
  1.  N DGICN     ;Integrated Control Number
  1.  N DGPFPAT   ;Patient identifying info
  1.  ;
  1.  S DGDFN=+$$GETDFN^MPIF001($G(@DGORF@("ICN")))
  1.  ;
  1.  ;retrieve patient identifying info
  1.  I $$GETPAT^DGPFUT2(DGDFN,.DGPFPAT)
  1.  ;
  1.  ;set 1st line of header
  1.  S DGPFHDR(1)="Patient: "_$G(DGPFPAT("NAME"))_" "
  1.  S DGPFHDR(1)=$$SETSTR^VALM1("("_$G(DGPFPAT("SSN"))_")",DGPFHDR(1),$L(DGPFHDR(1))+1,80)
  1.  S DGPFHDR(1)=$$SETSTR^VALM1("DOB: "_$$FDATE^VALM1($G(DGPFPAT("DOB"))),DGPFHDR(1),54,80)
  1.  ;
  1.  ;set 2nd line of header
  1.  S DGICN=$G(@DGORF@("ICN"))
  1.  S DGICN=$S(DGICN<0:"No ICN for patient",1:DGICN)
  1.  S DGPFHDR(2)="    ICN: "_DGICN
  1.  S DGFACNAM=$$EXTERNAL^DILFD(26.13,.04,"F",$$IEN^XUAF4($G(@DGORF@("SNDFAC"))))
  1.  S DGPFHDR(2)=$$SETSTR^VALM1("FACILITY QUERIED: "_DGFACNAM,DGPFHDR(2),41,27)
  1.  Q
  1.  ;
  1.  ;
  1. BLDLIST(DGORF) ;build list of returned assignments
  1.  ;
  1.  ;  Input:
  1.  ;    DGORF - parsed ORF segments data array
  1.  ;    
  1.  ;  Output: none
  1.  ;
  1.  D CLEAN^VALM10
  1.  N DGSET  ;flag assignment indicator
  1.  ;
  1.  ;
  1.  S DGSET=0,VALMCNT=0
  1.  F  S DGSET=$O(@DGORF@(DGSET)) Q:'DGSET  D
  1.  . S VALMCNT=VALMCNT+1
  1.  . N DGPFA   ;assignment data array
  1.  . ;
  1.  . ;load assignment data array
  1.  . D LDASGN^DGPFLMQ2(DGSET,DGORF,.DGPFA)
  1.  . ;
  1.  . S DGPFA("INITASSIGN")=$O(@DGORF@(DGSET,0))  ;initial assignment date
  1.  . ;
  1.  . ;get most recent assignment history to calculate current status
  1.  . S DGADT=$O(@DGORF@(DGSET,9999999.999999),-1)
  1.  . S DGPFA("STATUS")=$$STATUS^DGPFUT($G(@DGORF@(DGSET,DGADT,"ACTION")))
  1.  . S DGPFA("NUMACT")=$$NUMACT(DGSET,DGORF)
  1.  . ;
  1.  . ;build Assignment line
  1.  . D BLDLIN(VALMCNT,.DGPFA,DGSET)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. BLDLIN(DGLNUM,DGPFA,DGSET) ;build and format lines
  1.  ;This procedure will build and setup ListMan lines and array.
  1.  ;
  1.  ;  Input:
  1.  ;    DGLNUM - line number
  1.  ;     DGPFA - array containing assignment, passed by reference
  1.  ;     DGSET - set id representing a single PRF assignment
  1.  ;
  1.  ; Output: None
  1.  ;
  1.  N DGTXT      ;used as temporary text field
  1.  N DGLINE     ;string to insert field data
  1.  S DGLINE=""  ;init
  1.  S DGLINE=$$SETSTR^VALM1(DGLNUM,DGLINE,1,3)
  1.  ;
  1.  ;flag name
  1.  S DGTXT=$$EXTERNAL^DILFD(26.13,.02,"F",$G(DGPFA("FLAG")))
  1.  S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"FLAG")
  1.  ;
  1.  ;initial assignment date
  1.  S DGTXT=$$FDATE^VALM1(+$G(DGPFA("INITASSIGN")))
  1.  S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"ASSIGN DATE")
  1.  ;
  1.  ;status/active (yes/no)
  1.  S DGTXT=$P($G(DGPFA("STATUS")),U)
  1.  S DGTXT=$S(DGTXT=1:"YES",1:"NO")
  1.  S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"STATUS")
  1.  ;
  1.  ;# of actions
  1.  S DGTXT=DGPFA("NUMACT")
  1.  S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"ACTION CNT")
  1.  ;
  1.  ;owner site
  1.  S DGTXT=$$EXTERNAL^DILFD(26.13,.04,"F",$G(DGPFA("OWNER")))
  1.  S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"OWNER SITE")
  1.  ;
  1.  ;construct initial list array and "IDX"
  1.  D SET^VALM10(DGLNUM,DGLINE,+$G(DGSET))
  1.  ;
  1.  Q
  1.  ;
  1. NUMACT(DGSET,DGORF) ;count actions
  1.  ;This function counts the number of assignment actions for a given
  1.  ;flag assignment.
  1.  ;
  1.  ;  Input:
  1.  ;    DGSET - set id representing a single PRF assignment
  1.  ;    DGORF - parsed ORF segments data array
  1.  ;
  1.  ;  Output:
  1.  ;   Function value - count of assignment actions
  1.  ;     
  1.  N DGADT  ;assignment date
  1.  N DGCNT  ;function value
  1.  ;
  1.  S DGADT=0,DGCNT=0
  1.  F  S DGADT=$O(@DGORF@(DGSET,DGADT)) Q:'DGADT  S DGCNT=DGCNT+1
  1.  ;
  1.  Q DGCNT
  1.  ;
  1.  ;
  1. DR ;Display Query Results action
  1.  ;This procedure is called by the DGPF DISPLAY QUERY RESULTS action
  1.  ;protocol.
  1.  ;
  1.  ;  Input:
  1.  ;    DGORF - parsed ORF segments data array passed globally
  1.  ;    
  1.  ;  Output:
  1.  ;    VALMBCK - 'R'= refresh screen
  1.  ;    
  1.  N DGSET  ;flag assignment indicator
  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.  . W !?6,"There are no record flag assignment query results 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,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)) D
  1.  . S DGSET=$O(@VALMAR@("IDX",SEL,""))
  1.  . ;-display query result flag assignment details
  1.  . N VALMHDR
  1.  . D EN^DGPFLMQD(DGSET,DGORF)
  1.  ;
  1.  ;return to LM (refresh screen)
  1.  S VALMBCK="R"
  1.  Q