DGPFLMQ2 ;ALB/RPM - PRF HL7 QUERY RESULTS DISPLAY UTILITIES ; 1/25/06 11:24
;;5.3;Registration;**650**;Aug 13, 1993;Build 3
;
Q ;no direct entry
;
EN(DGARY,DGSET,DGCNT) ;display ORF query results
;
; Input:
; DGARY - global array subscript
; DGSET - set id representing a single PRF assignment
;
; Output:
; DGCNT - number of lines in list, pass by reference
;
N DGADT ;assignment date
N DGHISCNT ;history action counter
N DGLINE ;list line counter
N DGPFA ;assignment data array
N DGPFAH ;assignment history data array
;
S (DGLINE,VALMBEG)=1
S DGCNT=0
;
;load assignment data array
D LDASGN(DGSET,DGORF,.DGPFA)
S DGPFA("INITASSIGN")=$O(@DGORF@(DGSET,0)) ;initial assignment date
;
;get most recent assignment history to calculate current status
S DGADT=$O(@DGORF@(DGSET,9999999.999999),-1)
S DGPFA("STATUS")=$$STATUS^DGPFUT($G(@DGORF@(DGSET,DGADT,"ACTION")))
;
;build Assignment Details area
D ASGN(DGARY,.DGPFA,.DGLINE,.DGCNT)
;
;build Assignment History heading
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,$TR($J("",80)," ","="),1,,,.DGCNT)
D SET(DGARY,DGLINE,"<Assignment History>",30,IORVON,IORVOFF,.DGCNT)
;
S DGHISCNT=0
S DGADT=9999999.999999 ;each DGADT represents a single PRF history action
F S DGADT=$O(@DGORF@(DGSET,DGADT),-1) Q:'DGADT D
. N DGPFAH ;assignment history data array
. S DGHISCNT=DGHISCNT+1
. ;
. ;load assignment history data array
. D LDHIST(DGSET,DGADT,DGORF,.DGPFAH)
. ;
. ;build History Details area
. D HIST(DGARY,.DGPFAH,.DGLINE,DGHISCNT,.DGCNT)
S ^TMP(DGARY,$J,"SET")=DGSET
Q
;
;
LDASGN(DGSET,DGORF,DGPFA) ;load assignment data array
;
; Input:
; DGSET - set id representing a single PRF assignment
; DGORF - parsed ORF segments data array
;
; Output:
; DGPFA - assignment data array
;
S DGPFA("DFN")=+$$GETDFN^MPIF001($G(@DGORF@("ICN")))
S DGPFA("FLAG")=$G(@DGORF@(DGSET,"FLAG"))
Q:DGPFA("FLAG")']""
;
;init STATUS as a placeholder, set value following history retrieval
S DGPFA("STATUS")=""
S DGPFA("OWNER")=$G(@DGORF@(DGSET,"OWNER"))
S DGPFA("ORIGSITE")=$G(@DGORF@(DGSET,"ORIGSITE"))
M DGPFA("NARR")=@DGORF@(DGSET,"NARR")
;
Q
;
;
LDHIST(DGSET,DGADT,DGORF,DGPFAH) ;load assignment history data array
;
; Input:
; DGSET - set id representing a single PRF assignment
; DGADT - assignment date
; DGORF - parsed ORF segments data array
;
; Output:
; DGPFAH - assignment history data array
;
S DGPFAH("ASSIGNDT")=DGADT
S DGPFAH("ACTION")=$G(@DGORF@(DGSET,DGADT,"ACTION"))
S DGPFAH("ENTERBY")=.5 ;POSTMASTER
S DGPFAH("APPRVBY")=.5 ;POSTMASTER
M DGPFAH("COMMENT")=@DGORF@(DGSET,DGADT,"COMMENT")
Q
;
;
ASGN(DGARY,DGPFA,DGLINE,DGCNT) ;format assignment details
;This procedure will build and format the lines of FLAG ASSIGNMENT
;details.
;
; Input:
; DGARY - global array subscript
; DGPFA - assignment array, pass by reference
; DGLINE - line counter, pass by reference
;
; Output:
; DGCNT - number of lines in the list, pass by reference
;
;temporary variables used
N DGSUB
N DGTMP
N DGTXT
;
;set flag name
S DGTXT=$$EXTERNAL^DILFD(26.13,.02,"F",$G(DGPFA("FLAG")))
I DGTXT="" S DGTXT="**FLAG not defined**"
D SET(DGARY,DGLINE,"Flag Name: "_DGTXT,12,,,.DGCNT)
;
;set flag assignment status
S DGLINE=DGLINE+1
S DGTXT=$$EXTERNAL^DILFD(26.13,.03,"F",$G(DGPFA("STATUS")))
D SET(DGARY,DGLINE,"Assignment Status: "_DGTXT,4,,,.DGCNT)
;
;set initial assignment date
S DGLINE=DGLINE+1
S DGTXT=$$FDTTM^VALM1($P(+$G(DGPFA("INITASSIGN")),U))
D SET(DGARY,DGLINE,"Initial Assignment: "_DGTXT,3,,,.DGCNT)
;
;set owner site
S DGLINE=DGLINE+1
S DGTXT=$$EXTERNAL^DILFD(26.13,.04,"F",$G(DGPFA("OWNER")))
D SET(DGARY,DGLINE,"Owner Site: "_DGTXT_" "_$$FMTPRNT^DGPFUT1($P($G(DGPFA("OWNER")),U)),11,,,.DGCNT)
;
;set originating site
S DGLINE=DGLINE+1
S DGTXT=$$EXTERNAL^DILFD(26.13,.04,"F",$G(DGPFA("ORIGSITE")))
D SET(DGARY,DGLINE,"Originating Site: "_DGTXT_" "_$$FMTPRNT^DGPFUT1($P($G(DGPFA("ORIGSITE")),U)),5,,,.DGCNT)
;
;set assignment narrative
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"",1,,,.DGCNT)
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Record Flag Assignment Narrative:",1,IORVON,IORVOFF,.DGCNT)
I '$D(DGPFA("NARR",1,0)) D Q
. S DGLINE=DGLINE+1
. D SET(DGARY,DGLINE,"No Narrative Text",1,,,.DGCNT)
S (DGSUB,DGTMP)=""
F S DGSUB=$O(DGPFA("NARR",DGSUB)) Q:'DGSUB D
. S DGTMP=$G(DGPFA("NARR",DGSUB,0))
. S DGLINE=DGLINE+1
. D SET(DGARY,DGLINE,DGTMP,1,,,.DGCNT)
;
;set blank lines
S DGLINE=DGLINE+2
D SET(DGARY,DGLINE,"",1,,,.DGCNT)
;
Q
;
;
HIST(DGARY,DGPFAH,DGLINE,DGHISCNT,DGCNT) ;format history details
;This procedure will build and format the lines of FLAG ASSIGNMENT
;HISTORY details.
;
; Input:
; DGARY - global array subscript
; DGPFAH - assignment history array, pass by reference
; DGLINE - line counter, pass by reference
; DGHISCNT - counter of history record
;
; Output:
; DGCNT - number of lines in the list, pass by reference
;
;temporary variables used
N DGTMP
N DGSUB
;
;set blank line
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"",1,,,.DGCNT)
;
;add an additional blank line except on the first history
I DGHISCNT>1 D
. S DGLINE=DGLINE+1
. D SET(DGARY,DGLINE,"",1,,,.DGCNT)
;
;set action
S DGLINE=DGLINE+1
S DGTMP=DGHISCNT_"."
D SET(DGARY,DGLINE,DGTMP,1,IORVON,IORVOFF,.DGCNT)
D SET(DGARY,DGLINE,"Action: "_$$EXTERNAL^DILFD(26.14,.03,"F",$G(DGPFAH("ACTION"))),10,IORVON,IORVOFF,.DGCNT)
;
;set assignment date
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Action Date: "_$$FDTTM^VALM1($P($G(DGPFAH("ASSIGNDT")),U)),5,,,.DGCNT)
;
;set history comments
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Action Comments:",1,,,.DGCNT)
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"----------------",1,,,.DGCNT)
I $D(DGPFAH("COMMENT",1,0)) D
. S (DGSUB,DGTMP)=""
. F S DGSUB=$O(DGPFAH("COMMENT",DGSUB)) Q:'DGSUB D
.. S DGTMP=$G(DGPFAH("COMMENT",DGSUB,0))
.. S DGLINE=DGLINE+1
.. D SET(DGARY,DGLINE,DGTMP,1,,,.DGCNT)
E D
. S DGLINE=DGLINE+1
. D SET(DGARY,DGLINE,"No Comments on file.",1,,,.DGCNT)
;
Q
;
;
SET(DGARY,DGLINE,DGTEXT,DGCOL,DGON,DGOFF,DGCNT) ;This procedure will set the lines of flag assignment details into the LM display area.
;
; Input:
; DGARY - global array subscript
; DGLINE - line number
; DGTEXT - text
; DGCOL - starting column
; DGON - highlighting on
; DGOFF - highlighting off
;
; Output:
; DGCNT - number of lines in the list, pass by reference
;
N DGX ;temp variable for line of display text
;
S DGCNT=DGLINE
S DGX=$S($D(^TMP(DGARY,$J,DGLINE,0)):^(0),1:"")
S ^TMP(DGARY,$J,DGLINE,0)=$$SETSTR^VALM1(DGTEXT,DGX,DGCOL,$L(DGTEXT))
D:$G(DGON)]""!($G(DGOFF)]"") CNTRL^VALM10(DGLINE,DGCOL,$L(DGTEXT),$G(DGON),$G(DGOFF))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFLMQ2 6983 printed Dec 13, 2024@02:48:20 Page 2
DGPFLMQ2 ;ALB/RPM - PRF HL7 QUERY RESULTS DISPLAY UTILITIES ; 1/25/06 11:24
+1 ;;5.3;Registration;**650**;Aug 13, 1993;Build 3
+2 ;
+3 ;no direct entry
QUIT
+4 ;
EN(DGARY,DGSET,DGCNT) ;display ORF query results
+1 ;
+2 ; Input:
+3 ; DGARY - global array subscript
+4 ; DGSET - set id representing a single PRF assignment
+5 ;
+6 ; Output:
+7 ; DGCNT - number of lines in list, pass by reference
+8 ;
+9 ;assignment date
NEW DGADT
+10 ;history action counter
NEW DGHISCNT
+11 ;list line counter
NEW DGLINE
+12 ;assignment data array
NEW DGPFA
+13 ;assignment history data array
NEW DGPFAH
+14 ;
+15 SET (DGLINE,VALMBEG)=1
+16 SET DGCNT=0
+17 ;
+18 ;load assignment data array
+19 DO LDASGN(DGSET,DGORF,.DGPFA)
+20 ;initial assignment date
SET DGPFA("INITASSIGN")=$ORDER(@DGORF@(DGSET,0))
+21 ;
+22 ;get most recent assignment history to calculate current status
+23 SET DGADT=$ORDER(@DGORF@(DGSET,9999999.999999),-1)
+24 SET DGPFA("STATUS")=$$STATUS^DGPFUT($GET(@DGORF@(DGSET,DGADT,"ACTION")))
+25 ;
+26 ;build Assignment Details area
+27 DO ASGN(DGARY,.DGPFA,.DGLINE,.DGCNT)
+28 ;
+29 ;build Assignment History heading
+30 SET DGLINE=DGLINE+1
+31 DO SET(DGARY,DGLINE,$TRANSLATE($JUSTIFY("",80)," ","="),1,,,.DGCNT)
+32 DO SET(DGARY,DGLINE,"<Assignment History>",30,IORVON,IORVOFF,.DGCNT)
+33 ;
+34 SET DGHISCNT=0
+35 ;each DGADT represents a single PRF history action
SET DGADT=9999999.999999
+36 FOR
SET DGADT=$ORDER(@DGORF@(DGSET,DGADT),-1)
if 'DGADT
QUIT
Begin DoDot:1
+37 ;assignment history data array
NEW DGPFAH
+38 SET DGHISCNT=DGHISCNT+1
+39 ;
+40 ;load assignment history data array
+41 DO LDHIST(DGSET,DGADT,DGORF,.DGPFAH)
+42 ;
+43 ;build History Details area
+44 DO HIST(DGARY,.DGPFAH,.DGLINE,DGHISCNT,.DGCNT)
End DoDot:1
+45 SET ^TMP(DGARY,$JOB,"SET")=DGSET
+46 QUIT
+47 ;
+48 ;
LDASGN(DGSET,DGORF,DGPFA) ;load assignment data array
+1 ;
+2 ; Input:
+3 ; DGSET - set id representing a single PRF assignment
+4 ; DGORF - parsed ORF segments data array
+5 ;
+6 ; Output:
+7 ; DGPFA - assignment data array
+8 ;
+9 SET DGPFA("DFN")=+$$GETDFN^MPIF001($GET(@DGORF@("ICN")))
+10 SET DGPFA("FLAG")=$GET(@DGORF@(DGSET,"FLAG"))
+11 if DGPFA("FLAG")']""
QUIT
+12 ;
+13 ;init STATUS as a placeholder, set value following history retrieval
+14 SET DGPFA("STATUS")=""
+15 SET DGPFA("OWNER")=$GET(@DGORF@(DGSET,"OWNER"))
+16 SET DGPFA("ORIGSITE")=$GET(@DGORF@(DGSET,"ORIGSITE"))
+17 MERGE DGPFA("NARR")=@DGORF@(DGSET,"NARR")
+18 ;
+19 QUIT
+20 ;
+21 ;
LDHIST(DGSET,DGADT,DGORF,DGPFAH) ;load assignment history data array
+1 ;
+2 ; Input:
+3 ; DGSET - set id representing a single PRF assignment
+4 ; DGADT - assignment date
+5 ; DGORF - parsed ORF segments data array
+6 ;
+7 ; Output:
+8 ; DGPFAH - assignment history data array
+9 ;
+10 SET DGPFAH("ASSIGNDT")=DGADT
+11 SET DGPFAH("ACTION")=$GET(@DGORF@(DGSET,DGADT,"ACTION"))
+12 ;POSTMASTER
SET DGPFAH("ENTERBY")=.5
+13 ;POSTMASTER
SET DGPFAH("APPRVBY")=.5
+14 MERGE DGPFAH("COMMENT")=@DGORF@(DGSET,DGADT,"COMMENT")
+15 QUIT
+16 ;
+17 ;
ASGN(DGARY,DGPFA,DGLINE,DGCNT) ;format assignment details
+1 ;This procedure will build and format the lines of FLAG ASSIGNMENT
+2 ;details.
+3 ;
+4 ; Input:
+5 ; DGARY - global array subscript
+6 ; DGPFA - assignment array, pass by reference
+7 ; DGLINE - line counter, pass by reference
+8 ;
+9 ; Output:
+10 ; DGCNT - number of lines in the list, pass by reference
+11 ;
+12 ;temporary variables used
+13 NEW DGSUB
+14 NEW DGTMP
+15 NEW DGTXT
+16 ;
+17 ;set flag name
+18 SET DGTXT=$$EXTERNAL^DILFD(26.13,.02,"F",$GET(DGPFA("FLAG")))
+19 IF DGTXT=""
SET DGTXT="**FLAG not defined**"
+20 DO SET(DGARY,DGLINE,"Flag Name: "_DGTXT,12,,,.DGCNT)
+21 ;
+22 ;set flag assignment status
+23 SET DGLINE=DGLINE+1
+24 SET DGTXT=$$EXTERNAL^DILFD(26.13,.03,"F",$GET(DGPFA("STATUS")))
+25 DO SET(DGARY,DGLINE,"Assignment Status: "_DGTXT,4,,,.DGCNT)
+26 ;
+27 ;set initial assignment date
+28 SET DGLINE=DGLINE+1
+29 SET DGTXT=$$FDTTM^VALM1($PIECE(+$GET(DGPFA("INITASSIGN")),U))
+30 DO SET(DGARY,DGLINE,"Initial Assignment: "_DGTXT,3,,,.DGCNT)
+31 ;
+32 ;set owner site
+33 SET DGLINE=DGLINE+1
+34 SET DGTXT=$$EXTERNAL^DILFD(26.13,.04,"F",$GET(DGPFA("OWNER")))
+35 DO SET(DGARY,DGLINE,"Owner Site: "_DGTXT_" "_$$FMTPRNT^DGPFUT1($PIECE($GET(DGPFA("OWNER")),U)),11,,,.DGCNT)
+36 ;
+37 ;set originating site
+38 SET DGLINE=DGLINE+1
+39 SET DGTXT=$$EXTERNAL^DILFD(26.13,.04,"F",$GET(DGPFA("ORIGSITE")))
+40 DO SET(DGARY,DGLINE,"Originating Site: "_DGTXT_" "_$$FMTPRNT^DGPFUT1($PIECE($GET(DGPFA("ORIGSITE")),U)),5,,,.DGCNT)
+41 ;
+42 ;set assignment narrative
+43 SET DGLINE=DGLINE+1
+44 DO SET(DGARY,DGLINE,"",1,,,.DGCNT)
+45 SET DGLINE=DGLINE+1
+46 DO SET(DGARY,DGLINE,"Record Flag Assignment Narrative:",1,IORVON,IORVOFF,.DGCNT)
+47 IF '$DATA(DGPFA("NARR",1,0))
Begin DoDot:1
+48 SET DGLINE=DGLINE+1
+49 DO SET(DGARY,DGLINE,"No Narrative Text",1,,,.DGCNT)
End DoDot:1
QUIT
+50 SET (DGSUB,DGTMP)=""
+51 FOR
SET DGSUB=$ORDER(DGPFA("NARR",DGSUB))
if 'DGSUB
QUIT
Begin DoDot:1
+52 SET DGTMP=$GET(DGPFA("NARR",DGSUB,0))
+53 SET DGLINE=DGLINE+1
+54 DO SET(DGARY,DGLINE,DGTMP,1,,,.DGCNT)
End DoDot:1
+55 ;
+56 ;set blank lines
+57 SET DGLINE=DGLINE+2
+58 DO SET(DGARY,DGLINE,"",1,,,.DGCNT)
+59 ;
+60 QUIT
+61 ;
+62 ;
HIST(DGARY,DGPFAH,DGLINE,DGHISCNT,DGCNT) ;format history details
+1 ;This procedure will build and format the lines of FLAG ASSIGNMENT
+2 ;HISTORY details.
+3 ;
+4 ; Input:
+5 ; DGARY - global array subscript
+6 ; DGPFAH - assignment history array, pass by reference
+7 ; DGLINE - line counter, pass by reference
+8 ; DGHISCNT - counter of history record
+9 ;
+10 ; Output:
+11 ; DGCNT - number of lines in the list, pass by reference
+12 ;
+13 ;temporary variables used
+14 NEW DGTMP
+15 NEW DGSUB
+16 ;
+17 ;set blank line
+18 SET DGLINE=DGLINE+1
+19 DO SET(DGARY,DGLINE,"",1,,,.DGCNT)
+20 ;
+21 ;add an additional blank line except on the first history
+22 IF DGHISCNT>1
Begin DoDot:1
+23 SET DGLINE=DGLINE+1
+24 DO SET(DGARY,DGLINE,"",1,,,.DGCNT)
End DoDot:1
+25 ;
+26 ;set action
+27 SET DGLINE=DGLINE+1
+28 SET DGTMP=DGHISCNT_"."
+29 DO SET(DGARY,DGLINE,DGTMP,1,IORVON,IORVOFF,.DGCNT)
+30 DO SET(DGARY,DGLINE,"Action: "_$$EXTERNAL^DILFD(26.14,.03,"F",$GET(DGPFAH("ACTION"))),10,IORVON,IORVOFF,.DGCNT)
+31 ;
+32 ;set assignment date
+33 SET DGLINE=DGLINE+1
+34 DO SET(DGARY,DGLINE,"Action Date: "_$$FDTTM^VALM1($PIECE($GET(DGPFAH("ASSIGNDT")),U)),5,,,.DGCNT)
+35 ;
+36 ;set history comments
+37 SET DGLINE=DGLINE+1
+38 DO SET(DGARY,DGLINE,"Action Comments:",1,,,.DGCNT)
+39 SET DGLINE=DGLINE+1
+40 DO SET(DGARY,DGLINE,"----------------",1,,,.DGCNT)
+41 IF $DATA(DGPFAH("COMMENT",1,0))
Begin DoDot:1
+42 SET (DGSUB,DGTMP)=""
+43 FOR
SET DGSUB=$ORDER(DGPFAH("COMMENT",DGSUB))
if 'DGSUB
QUIT
Begin DoDot:2
+44 SET DGTMP=$GET(DGPFAH("COMMENT",DGSUB,0))
+45 SET DGLINE=DGLINE+1
+46 DO SET(DGARY,DGLINE,DGTMP,1,,,.DGCNT)
End DoDot:2
End DoDot:1
+47 IF '$TEST
Begin DoDot:1
+48 SET DGLINE=DGLINE+1
+49 DO SET(DGARY,DGLINE,"No Comments on file.",1,,,.DGCNT)
End DoDot:1
+50 ;
+51 QUIT
+52 ;
+53 ;
SET(DGARY,DGLINE,DGTEXT,DGCOL,DGON,DGOFF,DGCNT) ;This procedure will set the lines of flag assignment details into the LM display area.
+1 ;
+2 ; Input:
+3 ; DGARY - global array subscript
+4 ; DGLINE - line number
+5 ; DGTEXT - text
+6 ; DGCOL - starting column
+7 ; DGON - highlighting on
+8 ; DGOFF - highlighting off
+9 ;
+10 ; Output:
+11 ; DGCNT - number of lines in the list, pass by reference
+12 ;
+13 ;temp variable for line of display text
NEW DGX
+14 ;
+15 SET DGCNT=DGLINE
+16 SET DGX=$SELECT($DATA(^TMP(DGARY,$JOB,DGLINE,0)):^(0),1:"")
+17 SET ^TMP(DGARY,$JOB,DGLINE,0)=$$SETSTR^VALM1(DGTEXT,DGX,DGCOL,$LENGTH(DGTEXT))
+18 if $GET(DGON)]""!($GET(DGOFF)]"")
DO CNTRL^VALM10(DGLINE,DGCOL,$LENGTH(DGTEXT),$GET(DGON),$GET(DGOFF))
+19 QUIT
