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

DGPFLMQ2.m

Go to the documentation of this file. 
  1. DGPFLMQ2 ;ALB/RPM - PRF HL7 QUERY RESULTS DISPLAY UTILITIES ; 1/25/06 11:24
  1.  ;;5.3;Registration;**650,1015**;Aug 13, 1993;Build 21
  1.  ;
  1.  Q  ;no direct entry
  1.  ;
  1. EN(DGARY,DGSET,DGCNT) ;display ORF query results
  1.  ;
  1.  ;  Input:
  1.  ;    DGARY - global array subscript
  1.  ;    DGSET - set id representing a single PRF assignment
  1.  ;
  1.  ;  Output:
  1.  ;    DGCNT - number of lines in list, pass by reference
  1.  ;
  1.  N DGADT     ;assignment date
  1.  N DGHISCNT  ;history action counter
  1.  N DGLINE    ;list line counter
  1.  N DGPFA     ;assignment data array
  1.  N DGPFAH    ;assignment history data array
  1.  ;
  1.  S (DGLINE,VALMBEG)=1
  1.  S DGCNT=0
  1.  ;
  1.  ;load assignment data array
  1.  D LDASGN(DGSET,DGORF,.DGPFA)
  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.  ;
  1.  ;build Assignment Details area
  1.  D ASGN(DGARY,.DGPFA,.DGLINE,.DGCNT)
  1.  ;
  1.  ;build Assignment History heading
  1.  S DGLINE=DGLINE+1
  1.  D SET(DGARY,DGLINE,$TR($J("",80)," ","="),1,,,.DGCNT)
  1.  D SET(DGARY,DGLINE,"<Assignment History>",30,IORVON,IORVOFF,.DGCNT)
  1.  ;
  1.  S DGHISCNT=0
  1.  S DGADT=9999999.999999  ;each DGADT represents a single PRF history action
  1.  F  S DGADT=$O(@DGORF@(DGSET,DGADT),-1) Q:'DGADT  D
  1.  . N DGPFAH   ;assignment history data array
  1.  . S DGHISCNT=DGHISCNT+1
  1.  . ;
  1.  . ;load assignment history data array
  1.  . D LDHIST(DGSET,DGADT,DGORF,.DGPFAH)
  1.  . ;
  1.  . ;build History Details area
  1.  . D HIST(DGARY,.DGPFAH,.DGLINE,DGHISCNT,.DGCNT)
  1.  S ^TMP(DGARY,$J,"SET")=DGSET
  1.  Q
  1.  ;
  1.  ;
  1. LDASGN(DGSET,DGORF,DGPFA) ;load assignment data array
  1.  ;
  1.  ;  Input:
  1.  ;    DGSET - set id representing a single PRF assignment
  1.  ;    DGORF - parsed ORF segments data array
  1.  ;
  1.  ;  Output:
  1.  ;    DGPFA - assignment data array
  1.  ;
  1.  S DGPFA("DFN")=+$$GETDFN^MPIF001($G(@DGORF@("ICN")))
  1.  S DGPFA("FLAG")=$G(@DGORF@(DGSET,"FLAG"))
  1.  Q:DGPFA("FLAG")']""
  1.  ;
  1.  ;init STATUS as a placeholder, set value following history retrieval
  1.  S DGPFA("STATUS")=""
  1.  S DGPFA("OWNER")=$G(@DGORF@(DGSET,"OWNER"))
  1.  S DGPFA("ORIGSITE")=$G(@DGORF@(DGSET,"ORIGSITE"))
  1.  M DGPFA("NARR")=@DGORF@(DGSET,"NARR")
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. LDHIST(DGSET,DGADT,DGORF,DGPFAH) ;load assignment history data array
  1.  ;
  1.  ;  Input:
  1.  ;    DGSET - set id representing a single PRF assignment
  1.  ;    DGADT - assignment date
  1.  ;    DGORF - parsed ORF segments data array
  1.  ;
  1.  ;  Output:
  1.  ;    DGPFAH - assignment history data array
  1.  ;
  1.  S DGPFAH("ASSIGNDT")=DGADT
  1.  S DGPFAH("ACTION")=$G(@DGORF@(DGSET,DGADT,"ACTION"))
  1.  S DGPFAH("ENTERBY")=.5  ;POSTMASTER
  1.  S DGPFAH("APPRVBY")=.5  ;POSTMASTER
  1.  M DGPFAH("COMMENT")=@DGORF@(DGSET,DGADT,"COMMENT")
  1.  Q
  1.  ;
  1.  ;
  1. ASGN(DGARY,DGPFA,DGLINE,DGCNT) ;format assignment details
  1.  ;This procedure will build and format the lines of FLAG ASSIGNMENT
  1.  ;details.
  1.  ;
  1.  ;  Input:
  1.  ;    DGARY - global array subscript
  1.  ;    DGPFA - assignment array, pass by reference
  1.  ;   DGLINE - line counter, pass by reference
  1.  ;
  1.  ; Output:
  1.  ;    DGCNT - number of lines in the list, pass by reference
  1.  ;
  1.  ;temporary variables used
  1.  N DGSUB
  1.  N DGTMP
  1.  N DGTXT
  1.  ;
  1.  ;set flag name
  1.  S DGTXT=$$EXTERNAL^DILFD(26.13,.02,"F",$G(DGPFA("FLAG")))
  1.  I DGTXT="" S DGTXT="**FLAG not defined**"
  1.  D SET(DGARY,DGLINE,"Flag Name: "_DGTXT,12,,,.DGCNT)
  1.  ;
  1.  ;set flag assignment status
  1.  S DGLINE=DGLINE+1
  1.  S DGTXT=$$EXTERNAL^DILFD(26.13,.03,"F",$G(DGPFA("STATUS")))
  1.  D SET(DGARY,DGLINE,"Assignment Status: "_DGTXT,4,,,.DGCNT)
  1.  ;
  1.  ;set initial assignment date
  1.  S DGLINE=DGLINE+1
  1.  S DGTXT=$$FDTTM^VALM1($P(+$G(DGPFA("INITASSIGN")),U))
  1.  D SET(DGARY,DGLINE,"Initial Assignment: "_DGTXT,3,,,.DGCNT)
  1.  ;
  1.  ;set owner site
  1.  S DGLINE=DGLINE+1
  1.  S DGTXT=$$EXTERNAL^DILFD(26.13,.04,"F",$G(DGPFA("OWNER")))
  1.  D SET(DGARY,DGLINE,"Owner Site: "_DGTXT_"  "_$$FMTPRNT^DGPFUT1($P($G(DGPFA("OWNER")),U)),11,,,.DGCNT)
  1.  ;
  1.  ;set originating site
  1.  S DGLINE=DGLINE+1
  1.  S DGTXT=$$EXTERNAL^DILFD(26.13,.04,"F",$G(DGPFA("ORIGSITE")))
  1.  D SET(DGARY,DGLINE,"Originating Site: "_DGTXT_"  "_$$FMTPRNT^DGPFUT1($P($G(DGPFA("ORIGSITE")),U)),5,,,.DGCNT)
  1.  ;
  1.  ;set assignment narrative
  1.  S DGLINE=DGLINE+1
  1.  D SET(DGARY,DGLINE,"",1,,,.DGCNT)
  1.  S DGLINE=DGLINE+1
  1.  D SET(DGARY,DGLINE,"Record Flag Assignment Narrative:",1,IORVON,IORVOFF,.DGCNT)
  1.  I '$D(DGPFA("NARR",1,0)) D  Q
  1.  . S DGLINE=DGLINE+1
  1.  . D SET(DGARY,DGLINE,"No Narrative Text",1,,,.DGCNT)
  1.  S (DGSUB,DGTMP)=""
  1.  F  S DGSUB=$O(DGPFA("NARR",DGSUB)) Q:'DGSUB  D
  1.  . S DGTMP=$G(DGPFA("NARR",DGSUB,0))
  1.  . S DGLINE=DGLINE+1
  1.  . D SET(DGARY,DGLINE,DGTMP,1,,,.DGCNT)
  1.  ;
  1.  ;set blank lines
  1.  S DGLINE=DGLINE+2
  1.  D SET(DGARY,DGLINE,"",1,,,.DGCNT)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. HIST(DGARY,DGPFAH,DGLINE,DGHISCNT,DGCNT) ;format history details
  1.  ;This procedure will build and format the lines of FLAG ASSIGNMENT
  1.  ;HISTORY details.
  1.  ;
  1.  ;  Input:
  1.  ;    DGARY - global array subscript
  1.  ;   DGPFAH - assignment history array, pass by reference
  1.  ;   DGLINE - line counter, pass by reference
  1.  ; DGHISCNT - counter of history record
  1.  ;
  1.  ; Output:
  1.  ;    DGCNT - number of lines in the list, pass by reference
  1.  ;
  1.  ;temporary variables used
  1.  N DGTMP
  1.  N DGSUB
  1.  ;
  1.  ;set blank line
  1.  S DGLINE=DGLINE+1
  1.  D SET(DGARY,DGLINE,"",1,,,.DGCNT)
  1.  ;
  1.  ;add an additional blank line except on the first history
  1.  I DGHISCNT>1 D
  1.  . S DGLINE=DGLINE+1
  1.  . D SET(DGARY,DGLINE,"",1,,,.DGCNT)
  1.  ;
  1.  ;set action
  1.  S DGLINE=DGLINE+1
  1.  S DGTMP=DGHISCNT_"."
  1.  D SET(DGARY,DGLINE,DGTMP,1,IORVON,IORVOFF,.DGCNT)
  1.  D SET(DGARY,DGLINE,"Action: "_$$EXTERNAL^DILFD(26.14,.03,"F",$G(DGPFAH("ACTION"))),10,IORVON,IORVOFF,.DGCNT)
  1.  ;
  1.  ;set assignment date
  1.  S DGLINE=DGLINE+1
  1.  D SET(DGARY,DGLINE,"Action Date: "_$$FDTTM^VALM1($P($G(DGPFAH("ASSIGNDT")),U)),5,,,.DGCNT)
  1.  ;
  1.  ;set history comments
  1.  S DGLINE=DGLINE+1
  1.  D SET(DGARY,DGLINE,"Action Comments:",1,,,.DGCNT)
  1.  S DGLINE=DGLINE+1
  1.  D SET(DGARY,DGLINE,"----------------",1,,,.DGCNT)
  1.  I $D(DGPFAH("COMMENT",1,0)) D
  1.  . S (DGSUB,DGTMP)=""
  1.  . F  S DGSUB=$O(DGPFAH("COMMENT",DGSUB)) Q:'DGSUB  D
  1.  .. S DGTMP=$G(DGPFAH("COMMENT",DGSUB,0))
  1.  .. S DGLINE=DGLINE+1
  1.  .. D SET(DGARY,DGLINE,DGTMP,1,,,.DGCNT)
  1.  E  D
  1.  . S DGLINE=DGLINE+1
  1.  . D SET(DGARY,DGLINE,"No Comments on file.",1,,,.DGCNT)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. SET(DGARY,DGLINE,DGTEXT,DGCOL,DGON,DGOFF,DGCNT) ;This procedure will set the lines of flag assignment details into the LM display area.
  1.  ;
  1.  ;  Input:
  1.  ;    DGARY - global array subscript
  1.  ;   DGLINE - line number
  1.  ;   DGTEXT - text
  1.  ;    DGCOL - starting column
  1.  ;     DGON - highlighting on
  1.  ;    DGOFF - highlighting off
  1.  ;
  1.  ; Output:
  1.  ;    DGCNT - number of lines in the list, pass by reference
  1.  ;
  1.  N DGX  ;temp variable for line of display text
  1.  ;
  1.  S DGCNT=DGLINE
  1.  S DGX=$S($D(^TMP(DGARY,$J,DGLINE,0)):^(0),1:"")
  1.  S ^TMP(DGARY,$J,DGLINE,0)=$$SETSTR^VALM1(DGTEXT,DGX,DGCOL,$L(DGTEXT))
  1.  D:$G(DGON)]""!($G(DGOFF)]"") CNTRL^VALM10(DGLINE,DGCOL,$L(DGTEXT),$G(DGON),$G(DGOFF))
  1.  Q