DGPFLMU1 ;ALB/KCL - PRF DISPLAY FLAG DETAIL LM UTILITIES CONT ; 10/12/05 10:26am
;;5.3;Registration;**425,554,650,951**;Aug 13, 1993;Build 135
; Last Edited: SHRPE/SGM - Aug 16, 2018 11:02
;
;no direct entry
QUIT
;
EN(DGARY,DGIEN,DGDFN,DGCNT) ;Entry point to build flag assignment detail list area.
;
; Input:
; DGARY - global array subscript
; DGIEN - ien of PATIENT ASSIGNMENT (#26.13) file
; DGDFN - ien of PATIENT (#2) file
;
; Output:
; DGCNT - number of lines in the list, pass by reference
;
N DGHIEN ;assignment history ien
N DGHIENS ;contains assignment history ien's
N DGHISCNT ;count of history records
N DGLINE ;line counter
N DGPFA ;assignment array
N DGPFAH ;assignment history array
N DGPFF ;flag array
N DGSUB ;subscript of history ien's array
;
;init variables
S DGCNT=0
S (DGLINE,VALMBEG)=1
K DGPFA
K DGPFAH
K DGPFF
K DGHIENS
;
Q:'$G(DGIEN)
;
;get assignment into DGPFA array
Q:'$$GETASGN^DGPFAA(DGIEN,.DGPFA,1)
S DGPFA("INITASSIGN")=$$GETADT^DGPFAAH(DGIEN) ;initial assign date
;
;get most recent assignment history and place in DGPFAH array
Q:'$$GETHIST^DGPFAAH($$GETLAST^DGPFAAH(DGIEN),.DGPFAH,1)
;
;get record flag into DGPFF array
Q:'$$GETFLAG^DGPFUT1($P($G(DGPFA("FLAG")),U),.DGPFF)
;
;build Assignment Details area
D ASGN(DGARY,.DGPFA,.DGPFAH,.DGPFF,.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)
;
;get all history ien's associated with the assignment
Q:'$$GETALLDT^DGPFAAH(DGIEN,.DGHIENS)
;
;reverse loop through each assignment history ien
;and get record into DGPFAH array
S DGHISCNT=0,DGSUB=9999999.999999
F S DGSUB=$O(DGHIENS(DGSUB),-1) Q:DGSUB="" D
. S DGHIEN=+$G(DGHIENS(DGSUB))
. K DGPFAH
. I $$GETHIST^DGPFAAH(DGHIEN,.DGPFAH,1) D
. . ;
. . ;-history record counter
. . S DGHISCNT=DGHISCNT+1
. . ;
. . ;-build assignment history area
. . D HIST(DGARY,.DGPFAH,.DGPFA,.DGLINE,DGHISCNT,.DGCNT)
Q
;
;
ASGN(DGARY,DGPFA,DGPFAH,DGPFF,DGLINE,DGCNT) ;This procedure will build the lines of FLAG ASSIGNMENT details.
;
; Input:
; DGARY - global array subscript
; DGPFF - flag array, pass by reference
; DGPFA - assignment array, pass by reference
; DGPFAH - assignment history array, pass by reference
; DGLINE - line counter
;
; Output:
; DGCNT - number of lines in the list, pass by reference
;
;temporary variables used
N DGSUB
N DGTMP
;
;set flag name
D SET(DGARY,DGLINE,"Flag Name: "_$P($G(DGPFA("FLAG")),U,2),12,,,.DGCNT)
;
;set flag type
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Flag Type: "_$P($G(DGPFF("TYPE")),U,2),12,,,.DGCNT)
;
;set flag category
S DGLINE=DGLINE+1
S DGTMP=$S($P($G(DGPFA("FLAG")),U)["26.11":"II (LOCAL)",1:"I (NATIONAL)")
D SET(DGARY,DGLINE,"Flag Category: "_DGTMP,8,,,.DGCNT)
;
;set flag assignment status
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Assignment Status: "_$P($G(DGPFA("STATUS")),U,2),4,,,.DGCNT)
;
;set initial assignment date
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Initial Assignment: "_$$FDTTM^VALM1($P(+$G(DGPFA("INITASSIGN")),U)),3,,,.DGCNT)
;
;set last review date (do not set if only initial assignment)
S DGLINE=DGLINE+1
I (+$G(DGPFAH("ASSIGNDT")))=(+$G(DGPFA("INITASSIGN"))) D
. S DGTMP="N/A"
E S DGTMP=$$FDATE^VALM1(+$G(DGPFAH("ASSIGNDT")))
D SET(DGARY,DGLINE,"Last Review Date: "_DGTMP,5,,,.DGCNT)
;
;set next review date
S DGLINE=DGLINE+1
S DGTMP=+$G(DGPFA("REVIEWDT"))
S DGTMP=$S(DGTMP:$$FDATE^VALM1(DGTMP),1:"N/A")
D SET(DGARY,DGLINE,"Next Review Date: "_DGTMP,5,,,.DGCNT)
;
;set owner site
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Owner Site: "_$P($G(DGPFA("OWNER")),U,2)_" "_$$FMTPRNT^DGPFUT1($P($G(DGPFA("OWNER")),U)),11,,,.DGCNT)
;
;set originating site
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Originating Site: "_$P($G(DGPFA("ORIGSITE")),U,2)_" "_$$FMTPRNT^DGPFUT1($P($G(DGPFA("ORIGSITE")),U)),5,,,.DGCNT)
;
;add dbrs# data for behavioral flag ; DG*5.3*951
D DBRS(26.13)
;
;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,DGPFA,DGLINE,DGHISCNT,DGCNT) ;This procedure will build the lines of FLAG ASSIGNMENT HISTORY details.
;
; Input:
; DGARY - global array subscript
; DGPFAH - assignment history array, pass by reference
; DGPFA - assignment array, pass by reference
; DGLINE - line counter
; 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: "_$P($G(DGPFAH("ACTION")),U,2),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 entered by
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Entered By: "_$P($G(DGPFAH("ENTERBY")),U,2),6,,,.DGCNT)
;
;set approved by
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Approved By: "_$P($G(DGPFAH("APPRVBY")),U,2),5,,,.DGCNT)
;
;set progress note linked
I $D(^DG(40.8,"AD",+$P($G(DGPFA("OWNER")),U))) D
. Q:+$G(DGPFAH("ACTION"))=5 ;don't display ENTERED IN ERROR action
. S DGLINE=DGLINE+1
. D SET(DGARY,DGLINE,"Progress Note: "_$P($G(DGPFAH("TIULINK")),U,2),3,,,.DGCNT)
;
;add dbrs# data for behavioral flag ; DG*5.3*951
D DBRS(26.14)
;
;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
;
DBRS(FILE) ; DG*5.3*951
; Add DBRS data to the ListManager Display Assignment Details action
;
S FILE=$G(FILE) I FILE'=26.13,FILE'=26.14 Q
I FILE=26.13,'$D(DGPFA("DBRS#")) Q
I FILE=26.14,'$D(DGPFAH("DBRS")) Q
N I,TEXT
S TEXT="" D DBRSET
S TEXT="DBRS NUMBER",$E(TEXT,20)="DBRS OTHER INFORMATION" D DBRSET
S TEXT="",$P(TEXT,"-",80)="",$E(TEXT,19)=" " D DBRSET
I FILE=26.13 D
. S I=0 F S I=$O(DGPFA("DBRS#",I)) Q:'I D
. . S TEXT=$P(DGPFA("DBRS#",I),U)
. . S $E(TEXT,20)=$P($G(DGPFA("DBRS OTHER",I)),U)
. . D DBRSET
. . Q
. Q
I FILE=26.14 D
. S I=0 F S I=$O(DGPFAH("DBRS",I)) Q:'I D
. . S TEXT=$P(DGPFAH("DBRS",I),U)
. . S $E(TEXT,20)=$P(DGPFAH("DBRS",I),U,2)
. . D DBRSET
. . Q
. S TEXT="" D DBRSET
. Q
Q
;
DBRSET ;
S DGLINE=DGLINE+1 D SET(DGARY,DGLINE,TEXT,1,,,.DGCNT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFLMU1 8417 printed Dec 13, 2024@02:48:29 Page 2
DGPFLMU1 ;ALB/KCL - PRF DISPLAY FLAG DETAIL LM UTILITIES CONT ; 10/12/05 10:26am
+1 ;;5.3;Registration;**425,554,650,951**;Aug 13, 1993;Build 135
+2 ; Last Edited: SHRPE/SGM - Aug 16, 2018 11:02
+3 ;
+4 ;no direct entry
+5 QUIT
+6 ;
EN(DGARY,DGIEN,DGDFN,DGCNT) ;Entry point to build flag assignment detail list area.
+1 ;
+2 ; Input:
+3 ; DGARY - global array subscript
+4 ; DGIEN - ien of PATIENT ASSIGNMENT (#26.13) file
+5 ; DGDFN - ien of PATIENT (#2) file
+6 ;
+7 ; Output:
+8 ; DGCNT - number of lines in the list, pass by reference
+9 ;
+10 ;assignment history ien
NEW DGHIEN
+11 ;contains assignment history ien's
NEW DGHIENS
+12 ;count of history records
NEW DGHISCNT
+13 ;line counter
NEW DGLINE
+14 ;assignment array
NEW DGPFA
+15 ;assignment history array
NEW DGPFAH
+16 ;flag array
NEW DGPFF
+17 ;subscript of history ien's array
NEW DGSUB
+18 ;
+19 ;init variables
+20 SET DGCNT=0
+21 SET (DGLINE,VALMBEG)=1
+22 KILL DGPFA
+23 KILL DGPFAH
+24 KILL DGPFF
+25 KILL DGHIENS
+26 ;
+27 if '$GET(DGIEN)
QUIT
+28 ;
+29 ;get assignment into DGPFA array
+30 if '$$GETASGN^DGPFAA(DGIEN,.DGPFA,1)
QUIT
+31 ;initial assign date
SET DGPFA("INITASSIGN")=$$GETADT^DGPFAAH(DGIEN)
+32 ;
+33 ;get most recent assignment history and place in DGPFAH array
+34 if '$$GETHIST^DGPFAAH($$GETLAST^DGPFAAH(DGIEN),.DGPFAH,1)
QUIT
+35 ;
+36 ;get record flag into DGPFF array
+37 if '$$GETFLAG^DGPFUT1($PIECE($GET(DGPFA("FLAG")),U),.DGPFF)
QUIT
+38 ;
+39 ;build Assignment Details area
+40 DO ASGN(DGARY,.DGPFA,.DGPFAH,.DGPFF,.DGLINE,.DGCNT)
+41 ;
+42 ;build Assignment History heading
+43 SET DGLINE=DGLINE+1
+44 DO SET(DGARY,DGLINE,$TRANSLATE($JUSTIFY("",80)," ","="),1,,,.DGCNT)
+45 DO SET(DGARY,DGLINE,"<Assignment History>",30,IORVON,IORVOFF,.DGCNT)
+46 ;
+47 ;get all history ien's associated with the assignment
+48 if '$$GETALLDT^DGPFAAH(DGIEN,.DGHIENS)
QUIT
+49 ;
+50 ;reverse loop through each assignment history ien
+51 ;and get record into DGPFAH array
+52 SET DGHISCNT=0
SET DGSUB=9999999.999999
+53 FOR
SET DGSUB=$ORDER(DGHIENS(DGSUB),-1)
if DGSUB=""
QUIT
Begin DoDot:1
+54 SET DGHIEN=+$GET(DGHIENS(DGSUB))
+55 KILL DGPFAH
+56 IF $$GETHIST^DGPFAAH(DGHIEN,.DGPFAH,1)
Begin DoDot:2
+57 ;
+58 ;-history record counter
+59 SET DGHISCNT=DGHISCNT+1
+60 ;
+61 ;-build assignment history area
+62 DO HIST(DGARY,.DGPFAH,.DGPFA,.DGLINE,DGHISCNT,.DGCNT)
End DoDot:2
End DoDot:1
+63 QUIT
+64 ;
+65 ;
ASGN(DGARY,DGPFA,DGPFAH,DGPFF,DGLINE,DGCNT) ;This procedure will build the lines of FLAG ASSIGNMENT details.
+1 ;
+2 ; Input:
+3 ; DGARY - global array subscript
+4 ; DGPFF - flag array, pass by reference
+5 ; DGPFA - assignment array, pass by reference
+6 ; DGPFAH - assignment history array, pass by reference
+7 ; DGLINE - line counter
+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 ;
+16 ;set flag name
+17 DO SET(DGARY,DGLINE,"Flag Name: "_$PIECE($GET(DGPFA("FLAG")),U,2),12,,,.DGCNT)
+18 ;
+19 ;set flag type
+20 SET DGLINE=DGLINE+1
+21 DO SET(DGARY,DGLINE,"Flag Type: "_$PIECE($GET(DGPFF("TYPE")),U,2),12,,,.DGCNT)
+22 ;
+23 ;set flag category
+24 SET DGLINE=DGLINE+1
+25 SET DGTMP=$SELECT($PIECE($GET(DGPFA("FLAG")),U)["26.11":"II (LOCAL)",1:"I (NATIONAL)")
+26 DO SET(DGARY,DGLINE,"Flag Category: "_DGTMP,8,,,.DGCNT)
+27 ;
+28 ;set flag assignment status
+29 SET DGLINE=DGLINE+1
+30 DO SET(DGARY,DGLINE,"Assignment Status: "_$PIECE($GET(DGPFA("STATUS")),U,2),4,,,.DGCNT)
+31 ;
+32 ;set initial assignment date
+33 SET DGLINE=DGLINE+1
+34 DO SET(DGARY,DGLINE,"Initial Assignment: "_$$FDTTM^VALM1($PIECE(+$GET(DGPFA("INITASSIGN")),U)),3,,,.DGCNT)
+35 ;
+36 ;set last review date (do not set if only initial assignment)
+37 SET DGLINE=DGLINE+1
+38 IF (+$GET(DGPFAH("ASSIGNDT")))=(+$GET(DGPFA("INITASSIGN")))
Begin DoDot:1
+39 SET DGTMP="N/A"
End DoDot:1
+40 IF '$TEST
SET DGTMP=$$FDATE^VALM1(+$GET(DGPFAH("ASSIGNDT")))
+41 DO SET(DGARY,DGLINE,"Last Review Date: "_DGTMP,5,,,.DGCNT)
+42 ;
+43 ;set next review date
+44 SET DGLINE=DGLINE+1
+45 SET DGTMP=+$GET(DGPFA("REVIEWDT"))
+46 SET DGTMP=$SELECT(DGTMP:$$FDATE^VALM1(DGTMP),1:"N/A")
+47 DO SET(DGARY,DGLINE,"Next Review Date: "_DGTMP,5,,,.DGCNT)
+48 ;
+49 ;set owner site
+50 SET DGLINE=DGLINE+1
+51 DO SET(DGARY,DGLINE,"Owner Site: "_$PIECE($GET(DGPFA("OWNER")),U,2)_" "_$$FMTPRNT^DGPFUT1($PIECE($GET(DGPFA("OWNER")),U)),11,,,.DGCNT)
+52 ;
+53 ;set originating site
+54 SET DGLINE=DGLINE+1
+55 DO SET(DGARY,DGLINE,"Originating Site: "_$PIECE($GET(DGPFA("ORIGSITE")),U,2)_" "_$$FMTPRNT^DGPFUT1($PIECE($GET(DGPFA("ORIGSITE")),U)),5,,,.DGCNT)
+56 ;
+57 ;add dbrs# data for behavioral flag ; DG*5.3*951
+58 DO DBRS(26.13)
+59 ;
+60 ;set assignment narrative
+61 SET DGLINE=DGLINE+1
+62 DO SET(DGARY,DGLINE,"",1,,,.DGCNT)
+63 SET DGLINE=DGLINE+1
+64 DO SET(DGARY,DGLINE,"Record Flag Assignment Narrative:",1,IORVON,IORVOFF,.DGCNT)
+65 IF '$DATA(DGPFA("NARR",1,0))
Begin DoDot:1
+66 SET DGLINE=DGLINE+1
+67 DO SET(DGARY,DGLINE,"No Narrative Text",1,,,.DGCNT)
End DoDot:1
QUIT
+68 SET (DGSUB,DGTMP)=""
+69 FOR
SET DGSUB=$ORDER(DGPFA("NARR",DGSUB))
if 'DGSUB
QUIT
Begin DoDot:1
+70 SET DGTMP=$GET(DGPFA("NARR",DGSUB,0))
+71 SET DGLINE=DGLINE+1
+72 DO SET(DGARY,DGLINE,DGTMP,1,,,.DGCNT)
End DoDot:1
+73 ;
+74 ;set blank lines
+75 SET DGLINE=DGLINE+2
+76 DO SET(DGARY,DGLINE,"",1,,,.DGCNT)
+77 ;
+78 QUIT
+79 ;
+80 ;
HIST(DGARY,DGPFAH,DGPFA,DGLINE,DGHISCNT,DGCNT) ;This procedure will build the lines of FLAG ASSIGNMENT HISTORY details.
+1 ;
+2 ; Input:
+3 ; DGARY - global array subscript
+4 ; DGPFAH - assignment history array, pass by reference
+5 ; DGPFA - assignment array, pass by reference
+6 ; DGLINE - line counter
+7 ; DGHISCNT - counter of history record
+8 ;
+9 ; Output:
+10 ; DGCNT - number of lines in the list, pass by reference
+11 ;
+12 ;temporary variables used
+13 NEW DGTMP
+14 NEW DGSUB
+15 ;
+16 ;set blank line
+17 SET DGLINE=DGLINE+1
+18 DO SET(DGARY,DGLINE,"",1,,,.DGCNT)
+19 ;
+20 ;add an additional blank line except on the first history
+21 IF DGHISCNT>1
Begin DoDot:1
+22 SET DGLINE=DGLINE+1
+23 DO SET(DGARY,DGLINE,"",1,,,.DGCNT)
End DoDot:1
+24 ;
+25 ;set action
+26 SET DGLINE=DGLINE+1
+27 SET DGTMP=DGHISCNT_"."
+28 DO SET(DGARY,DGLINE,DGTMP,1,IORVON,IORVOFF,.DGCNT)
+29 DO SET(DGARY,DGLINE,"Action: "_$PIECE($GET(DGPFAH("ACTION")),U,2),10,IORVON,IORVOFF,.DGCNT)
+30 ;
+31 ;set assignment date
+32 SET DGLINE=DGLINE+1
+33 DO SET(DGARY,DGLINE,"Action Date: "_$$FDTTM^VALM1($PIECE($GET(DGPFAH("ASSIGNDT")),U)),5,,,.DGCNT)
+34 ;
+35 ;set entered by
+36 SET DGLINE=DGLINE+1
+37 DO SET(DGARY,DGLINE,"Entered By: "_$PIECE($GET(DGPFAH("ENTERBY")),U,2),6,,,.DGCNT)
+38 ;
+39 ;set approved by
+40 SET DGLINE=DGLINE+1
+41 DO SET(DGARY,DGLINE,"Approved By: "_$PIECE($GET(DGPFAH("APPRVBY")),U,2),5,,,.DGCNT)
+42 ;
+43 ;set progress note linked
+44 IF $DATA(^DG(40.8,"AD",+$PIECE($GET(DGPFA("OWNER")),U)))
Begin DoDot:1
+45 ;don't display ENTERED IN ERROR action
if +$GET(DGPFAH("ACTION"))=5
QUIT
+46 SET DGLINE=DGLINE+1
+47 DO SET(DGARY,DGLINE,"Progress Note: "_$PIECE($GET(DGPFAH("TIULINK")),U,2),3,,,.DGCNT)
End DoDot:1
+48 ;
+49 ;add dbrs# data for behavioral flag ; DG*5.3*951
+50 DO DBRS(26.14)
+51 ;
+52 ;set history comments
+53 SET DGLINE=DGLINE+1
+54 DO SET(DGARY,DGLINE,"Action Comments:",1,,,.DGCNT)
+55 SET DGLINE=DGLINE+1
+56 DO SET(DGARY,DGLINE,"----------------",1,,,.DGCNT)
+57 IF $DATA(DGPFAH("COMMENT",1,0))
Begin DoDot:1
+58 SET (DGSUB,DGTMP)=""
+59 FOR
SET DGSUB=$ORDER(DGPFAH("COMMENT",DGSUB))
if 'DGSUB
QUIT
Begin DoDot:2
+60 SET DGTMP=$GET(DGPFAH("COMMENT",DGSUB,0))
+61 SET DGLINE=DGLINE+1
+62 DO SET(DGARY,DGLINE,DGTMP,1,,,.DGCNT)
End DoDot:2
End DoDot:1
+63 IF '$TEST
Begin DoDot:1
+64 SET DGLINE=DGLINE+1
+65 DO SET(DGARY,DGLINE,"No Comments on file.",1,,,.DGCNT)
End DoDot:1
+66 ;
+67 QUIT
+68 ;
SET(DGARY,DGLINE,DGTEXT,DGCOL,DGON,DGOFF,DGCNT) ;
+1 ; This procedure will set the lines of flag assignment details into
+2 ; the LM display area.
+3 ;
+4 ; Input:
+5 ; DGARY - global array subscript
+6 ; DGLINE - line number
+7 ; DGTEXT - text
+8 ; DGCOL - starting column
+9 ; DGON - highlighting on
+10 ; DGOFF - highlighting off
+11 ;
+12 ; Output:
+13 ; DGCNT - number of lines in the list, pass by reference
+14 ;
+15 ;temp variable for line of display text
NEW DGX
+16 ;
+17 SET DGCNT=DGLINE
+18 SET DGX=$SELECT($DATA(^TMP(DGARY,$JOB,DGLINE,0)):^(0),1:"")
+19 SET ^TMP(DGARY,$JOB,DGLINE,0)=$$SETSTR^VALM1(DGTEXT,DGX,DGCOL,$LENGTH(DGTEXT))
+20 if $GET(DGON)]""!($GET(DGOFF)]"")
DO CNTRL^VALM10(DGLINE,DGCOL,$LENGTH(DGTEXT),$GET(DGON),$GET(DGOFF))
+21 QUIT
+22 ;
DBRS(FILE) ; DG*5.3*951
+1 ; Add DBRS data to the ListManager Display Assignment Details action
+2 ;
+3 SET FILE=$GET(FILE)
IF FILE'=26.13
IF FILE'=26.14
QUIT
+4 IF FILE=26.13
IF '$DATA(DGPFA("DBRS#"))
QUIT
+5 IF FILE=26.14
IF '$DATA(DGPFAH("DBRS"))
QUIT
+6 NEW I,TEXT
+7 SET TEXT=""
DO DBRSET
+8 SET TEXT="DBRS NUMBER"
SET $EXTRACT(TEXT,20)="DBRS OTHER INFORMATION"
DO DBRSET
+9 SET TEXT=""
SET $PIECE(TEXT,"-",80)=""
SET $EXTRACT(TEXT,19)=" "
DO DBRSET
+10 IF FILE=26.13
Begin DoDot:1
+11 SET I=0
FOR
SET I=$ORDER(DGPFA("DBRS#",I))
if 'I
QUIT
Begin DoDot:2
+12 SET TEXT=$PIECE(DGPFA("DBRS#",I),U)
+13 SET $EXTRACT(TEXT,20)=$PIECE($GET(DGPFA("DBRS OTHER",I)),U)
+14 DO DBRSET
+15 QUIT
End DoDot:2
+16 QUIT
End DoDot:1
+17 IF FILE=26.14
Begin DoDot:1
+18 SET I=0
FOR
SET I=$ORDER(DGPFAH("DBRS",I))
if 'I
QUIT
Begin DoDot:2
+19 SET TEXT=$PIECE(DGPFAH("DBRS",I),U)
+20 SET $EXTRACT(TEXT,20)=$PIECE(DGPFAH("DBRS",I),U,2)
+21 DO DBRSET
+22 QUIT
End DoDot:2
+23 SET TEXT=""
DO DBRSET
+24 QUIT
End DoDot:1
+25 QUIT
+26 ;
DBRSET ;
+1 SET DGLINE=DGLINE+1
DO SET(DGARY,DGLINE,TEXT,1,,,.DGCNT)
+2 QUIT
