DGPFLMT4 ;ALB/RBS - PRF TRANSMIT VIEW MESSAGE BUILD LIST AREA ; 10/19/06 10:59am
;;5.3;Registration;**650**;Aug 13, 1993;Build 3
;
;no direct entry
QUIT
;
;
EN(DGARY,DGPFIEN,DGCNT) ;Entry point to build error detail list area.
;
; Input:
; DGARY - subscript name for temp global
; DGPFIEN - IEN of record
;
; Output:
; DGCNT - number of display lines, pass by reference (VALMCNT)
;
;quit if required input paramater not passed
Q:'$G(DGPFIEN)
;
S:$G(DGARY)="" DGARY="DGPFVDET"
;
N DGAIEN ;assignment ien
N DGCOD ;error code
N DGLI ;dialog text line number
N DGPFA ;assignment array
N DGPFAH ;assignment history data array
N DGPFL ;HL7 transmission log data array
N DGLINE ;line counter
N DGSUB ;subscript var
N DGPFL ;HL7 transmission log data array
N DIERR ;var returned from BLD^DIALOG
N DGTBL ;error code table array
N DGTEMP ;array returned from BLD^DIALOG with error msg text
;
;init variables
S DGLINE=0
K DGPFA,DGPFAH,DGPFL,DGTBL
;
;retrieve HL7 log data
Q:'$$GETLOG^DGPFHLL(DGPFIEN,.DGPFL)
Q:'+DGPFL("ASGNHIST")
;retrieve assignment history data to get PRF Assignment ien
Q:'$$GETHIST^DGPFAAH(+DGPFL("ASGNHIST"),.DGPFAH)
S DGAIEN=$P($G(DGPFAH("ASSIGN")),U,1)
Q:'DGAIEN
Q:'$$GETASGN^DGPFAA(DGAIEN,.DGPFA)
;
;set Error Received D/T
S DGLINE=DGLINE+1
D SET^DGPFLMT1(DGARY,DGLINE,"Error Received D/T: "_$$FDTTM^VALM1($P($G(DGPFL("ACKDT")),U,1)),10,,,.DGCNT)
;
;set Message Control ID
S DGLINE=DGLINE+1
D SET^DGPFLMT1(DGARY,DGLINE,"Message Control ID: "_$P($G(DGPFL("MSGID")),U,2),10,,,.DGCNT)
;
;set Flag Name
S DGLINE=DGLINE+1
D SET^DGPFLMT1(DGARY,DGLINE,"Flag Name: "_$P($G(DGPFA("FLAG")),U,2),19,,,.DGCNT)
;
;set Owner Site
S DGLINE=DGLINE+1
D SET^DGPFLMT1(DGARY,DGLINE,"Owner Site: "_$P($G(DGPFA("OWNER")),U,2),18,,,.DGCNT)
;
;set Assignment Transmitted To
S DGLINE=DGLINE+1
D SET^DGPFLMT1(DGARY,DGLINE,"Assignment Transmitted To: "_$P($G(DGPFL("SITE")),U,2),3,,,.DGCNT)
;
;set Assignment Transmission Date/Time
S DGLINE=DGLINE+1
D SET^DGPFLMT1(DGARY,DGLINE,"Assignment Transmission D/T: "_$$FDTTM^VALM1($P($G(DGPFL("TRANSDT")),U,1)),1,,,.DGCNT)
;
;set blank line
S DGLINE=DGLINE+1
D SET^DGPFLMT1(DGARY,DGLINE," ",1,,,.DGCNT)
;
;set Rejection Reason
S DGLINE=DGLINE+1
D SET^DGPFLMT1(DGARY,DGLINE,"Rejection Reason(s): ",1,,,.DGCNT)
;
;set underline
S DGLINE=DGLINE+1
D SET^DGPFLMT1(DGARY,DGLINE,"--------------------",1,,,.DGCNT)
;
;set no error code message
I $O(DGPFL("ERROR",""))="" D Q
. S DGLINE=DGLINE+1
. D SET^DGPFLMT1(DGARY,DGLINE,">>> There are no Rejection Reason codes on file.",1,,,.DGCNT)
;
;load error code table
D BLDVA086^DGPFHLU3(.DGTBL)
;
;loop and set error msg text lines
S DGSUB=0
F S DGSUB=$O(DGPFL("ERROR",DGSUB)) Q:'DGSUB D
. Q:$G(DGPFL("ERROR",DGSUB))']""
. K DGTEMP
. S DGCOD=DGPFL("ERROR",DGSUB)
. ;assume numeric error code is a DIALOG
. I DGCOD?1N.N D BLD^DIALOG(DGCOD,"","","DGTEMP")
. I $D(DGTEMP) D FORMAT(.DGTEMP,70)
. ;if not a DIALOG, then is it a table entry?
. I '$D(DGTEMP),DGCOD]"",$D(DGTBL(DGCOD,"DESC")) S DGTEMP(1)=DGTBL(DGCOD,"DESC") D FORMAT(.DGTEMP,70)
. ;not a DIALOG or table entry - then error is unknown
. I '$D(DGTEMP) S DGTEMP(1)="Unknown Error code: '"_DGCOD_"'"
. ;
. F DGLI=1:1 Q:'$D(DGTEMP(DGLI)) S DGLINE=DGLINE+1 D
. . I DGLI=1 D SET^DGPFLMT1(DGARY,DGLINE,DGSUB_". "_DGTEMP(DGLI),1,,,.DGCNT)
. . E D SET^DGPFLMT1(DGARY,DGLINE," "_DGTEMP(DGLI),1,,,.DGCNT)
;
Q
;
FORMAT(DGTEXT,DGMAX) ;format text lines to length
;This procedure formats an array of text lines to be less than a
;given maximum length.
;
; Supported DBIA: #10104 - $$TRIM^XLFSTR Kernel api to trim spaces
;
; Input:
; DGTEXT - (required) array of text lines (passed by reference)
; DGMAX - (optional) maximum line length (default = 75)
;
; Output:
; DGTEXT - re-formatted array of text lines
;
Q:'$D(DGTEXT)
;
N DGARRY ;temp array for re-formatting
N DGI ;loop var
N DGLN ;line counter var
N DGMORE ;leftover words
N DGNEWLN ;new text line
N DGOLDLN ;original text line
N DGSPOT ;position of text line to break at
;
S:'+$G(DGMAX) DGMAX=75
;
S (DGI,DGLN,DGMORE,DGNEWLN,DGOLDLN,DGSPOT)=""
;
F DGI=1:1 S DGOLDLN=$G(DGTEXT(DGI)) Q:'$L(DGOLDLN)&'$L(DGMORE) D
. I DGOLDLN'?1.P S DGOLDLN=$$TRIM^XLFSTR(DGOLDLN)
. I $L(DGOLDLN)'>DGMAX,'$L(DGMORE) D Q
. . S DGLN=DGLN+1,DGARRY(DGLN)=DGOLDLN
. ;
. I $L(DGMORE),(DGOLDLN?1.P!('$L(DGOLDLN))) D Q
. . S DGLN=DGLN+1,DGARRY(DGLN)=DGMORE,DGMORE=""
. . S:$L(DGOLDLN) DGLN=DGLN+1,DGARRY(DGLN)=DGOLDLN
. ;
. S:$L(DGMORE) DGOLDLN=DGMORE_" "_DGOLDLN,DGMORE=""
. ;
. I $L(DGOLDLN)>DGMAX F D Q:'$L(DGOLDLN)
. . S DGSPOT=$L($E(DGOLDLN,1,DGMAX)," ")
. . S DGNEWLN=$P(DGOLDLN," ",1,$S(DGSPOT>1:DGSPOT-1,1:1))
. . S DGLN=DGLN+1,DGARRY(DGLN)=DGNEWLN,DGNEWLN=""
. . S DGMORE=$P(DGOLDLN," ",$S(DGSPOT>1:DGSPOT,1:DGSPOT+1),$L(DGOLDLN," "))
. . I $L(DGMORE)>DGMAX S DGOLDLN=DGMORE,DGMORE=""
. . E S DGOLDLN=""
. E D
. . S DGLN=DGLN+1,DGARRY(DGLN)=DGOLDLN
;
I $D(DGARRY) K DGTEXT M DGTEXT=DGARRY
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFLMT4 5260 printed Apr 09, 2024@21:44:34 Page 2
DGPFLMT4 ;ALB/RBS - PRF TRANSMIT VIEW MESSAGE BUILD LIST AREA ; 10/19/06 10:59am
+1 ;;5.3;Registration;**650**;Aug 13, 1993;Build 3
+2 ;
+3 ;no direct entry
+4 QUIT
+5 ;
+6 ;
EN(DGARY,DGPFIEN,DGCNT) ;Entry point to build error detail list area.
+1 ;
+2 ; Input:
+3 ; DGARY - subscript name for temp global
+4 ; DGPFIEN - IEN of record
+5 ;
+6 ; Output:
+7 ; DGCNT - number of display lines, pass by reference (VALMCNT)
+8 ;
+9 ;quit if required input paramater not passed
+10 if '$GET(DGPFIEN)
QUIT
+11 ;
+12 if $GET(DGARY)=""
SET DGARY="DGPFVDET"
+13 ;
+14 ;assignment ien
NEW DGAIEN
+15 ;error code
NEW DGCOD
+16 ;dialog text line number
NEW DGLI
+17 ;assignment array
NEW DGPFA
+18 ;assignment history data array
NEW DGPFAH
+19 ;HL7 transmission log data array
NEW DGPFL
+20 ;line counter
NEW DGLINE
+21 ;subscript var
NEW DGSUB
+22 ;HL7 transmission log data array
NEW DGPFL
+23 ;var returned from BLD^DIALOG
NEW DIERR
+24 ;error code table array
NEW DGTBL
+25 ;array returned from BLD^DIALOG with error msg text
NEW DGTEMP
+26 ;
+27 ;init variables
+28 SET DGLINE=0
+29 KILL DGPFA,DGPFAH,DGPFL,DGTBL
+30 ;
+31 ;retrieve HL7 log data
+32 if '$$GETLOG^DGPFHLL(DGPFIEN,.DGPFL)
QUIT
+33 if '+DGPFL("ASGNHIST")
QUIT
+34 ;retrieve assignment history data to get PRF Assignment ien
+35 if '$$GETHIST^DGPFAAH(+DGPFL("ASGNHIST"),.DGPFAH)
QUIT
+36 SET DGAIEN=$PIECE($GET(DGPFAH("ASSIGN")),U,1)
+37 if 'DGAIEN
QUIT
+38 if '$$GETASGN^DGPFAA(DGAIEN,.DGPFA)
QUIT
+39 ;
+40 ;set Error Received D/T
+41 SET DGLINE=DGLINE+1
+42 DO SET^DGPFLMT1(DGARY,DGLINE,"Error Received D/T: "_$$FDTTM^VALM1($PIECE($GET(DGPFL("ACKDT")),U,1)),10,,,.DGCNT)
+43 ;
+44 ;set Message Control ID
+45 SET DGLINE=DGLINE+1
+46 DO SET^DGPFLMT1(DGARY,DGLINE,"Message Control ID: "_$PIECE($GET(DGPFL("MSGID")),U,2),10,,,.DGCNT)
+47 ;
+48 ;set Flag Name
+49 SET DGLINE=DGLINE+1
+50 DO SET^DGPFLMT1(DGARY,DGLINE,"Flag Name: "_$PIECE($GET(DGPFA("FLAG")),U,2),19,,,.DGCNT)
+51 ;
+52 ;set Owner Site
+53 SET DGLINE=DGLINE+1
+54 DO SET^DGPFLMT1(DGARY,DGLINE,"Owner Site: "_$PIECE($GET(DGPFA("OWNER")),U,2),18,,,.DGCNT)
+55 ;
+56 ;set Assignment Transmitted To
+57 SET DGLINE=DGLINE+1
+58 DO SET^DGPFLMT1(DGARY,DGLINE,"Assignment Transmitted To: "_$PIECE($GET(DGPFL("SITE")),U,2),3,,,.DGCNT)
+59 ;
+60 ;set Assignment Transmission Date/Time
+61 SET DGLINE=DGLINE+1
+62 DO SET^DGPFLMT1(DGARY,DGLINE,"Assignment Transmission D/T: "_$$FDTTM^VALM1($PIECE($GET(DGPFL("TRANSDT")),U,1)),1,,,.DGCNT)
+63 ;
+64 ;set blank line
+65 SET DGLINE=DGLINE+1
+66 DO SET^DGPFLMT1(DGARY,DGLINE," ",1,,,.DGCNT)
+67 ;
+68 ;set Rejection Reason
+69 SET DGLINE=DGLINE+1
+70 DO SET^DGPFLMT1(DGARY,DGLINE,"Rejection Reason(s): ",1,,,.DGCNT)
+71 ;
+72 ;set underline
+73 SET DGLINE=DGLINE+1
+74 DO SET^DGPFLMT1(DGARY,DGLINE,"--------------------",1,,,.DGCNT)
+75 ;
+76 ;set no error code message
+77 IF $ORDER(DGPFL("ERROR",""))=""
Begin DoDot:1
+78 SET DGLINE=DGLINE+1
+79 DO SET^DGPFLMT1(DGARY,DGLINE,">>> There are no Rejection Reason codes on file.",1,,,.DGCNT)
End DoDot:1
QUIT
+80 ;
+81 ;load error code table
+82 DO BLDVA086^DGPFHLU3(.DGTBL)
+83 ;
+84 ;loop and set error msg text lines
+85 SET DGSUB=0
+86 FOR
SET DGSUB=$ORDER(DGPFL("ERROR",DGSUB))
if 'DGSUB
QUIT
Begin DoDot:1
+87 if $GET(DGPFL("ERROR",DGSUB))']""
QUIT
+88 KILL DGTEMP
+89 SET DGCOD=DGPFL("ERROR",DGSUB)
+90 ;assume numeric error code is a DIALOG
+91 IF DGCOD?1N.N
DO BLD^DIALOG(DGCOD,"","","DGTEMP")
+92 IF $DATA(DGTEMP)
DO FORMAT(.DGTEMP,70)
+93 ;if not a DIALOG, then is it a table entry?
+94 IF '$DATA(DGTEMP)
IF DGCOD]""
IF $DATA(DGTBL(DGCOD,"DESC"))
SET DGTEMP(1)=DGTBL(DGCOD,"DESC")
DO FORMAT(.DGTEMP,70)
+95 ;not a DIALOG or table entry - then error is unknown
+96 IF '$DATA(DGTEMP)
SET DGTEMP(1)="Unknown Error code: '"_DGCOD_"'"
+97 ;
+98 FOR DGLI=1:1
if '$DATA(DGTEMP(DGLI))
QUIT
SET DGLINE=DGLINE+1
Begin DoDot:2
+99 IF DGLI=1
DO SET^DGPFLMT1(DGARY,DGLINE,DGSUB_". "_DGTEMP(DGLI),1,,,.DGCNT)
+100 IF '$TEST
DO SET^DGPFLMT1(DGARY,DGLINE," "_DGTEMP(DGLI),1,,,.DGCNT)
End DoDot:2
End DoDot:1
+101 ;
+102 QUIT
+103 ;
FORMAT(DGTEXT,DGMAX) ;format text lines to length
+1 ;This procedure formats an array of text lines to be less than a
+2 ;given maximum length.
+3 ;
+4 ; Supported DBIA: #10104 - $$TRIM^XLFSTR Kernel api to trim spaces
+5 ;
+6 ; Input:
+7 ; DGTEXT - (required) array of text lines (passed by reference)
+8 ; DGMAX - (optional) maximum line length (default = 75)
+9 ;
+10 ; Output:
+11 ; DGTEXT - re-formatted array of text lines
+12 ;
+13 if '$DATA(DGTEXT)
QUIT
+14 ;
+15 ;temp array for re-formatting
NEW DGARRY
+16 ;loop var
NEW DGI
+17 ;line counter var
NEW DGLN
+18 ;leftover words
NEW DGMORE
+19 ;new text line
NEW DGNEWLN
+20 ;original text line
NEW DGOLDLN
+21 ;position of text line to break at
NEW DGSPOT
+22 ;
+23 if '+$GET(DGMAX)
SET DGMAX=75
+24 ;
+25 SET (DGI,DGLN,DGMORE,DGNEWLN,DGOLDLN,DGSPOT)=""
+26 ;
+27 FOR DGI=1:1
SET DGOLDLN=$GET(DGTEXT(DGI))
if '$LENGTH(DGOLDLN)&'$LENGTH(DGMORE)
QUIT
Begin DoDot:1
+28 IF DGOLDLN'?1.P
SET DGOLDLN=$$TRIM^XLFSTR(DGOLDLN)
+29 IF $LENGTH(DGOLDLN)'>DGMAX
IF '$LENGTH(DGMORE)
Begin DoDot:2
+30 SET DGLN=DGLN+1
SET DGARRY(DGLN)=DGOLDLN
End DoDot:2
QUIT
+31 ;
+32 IF $LENGTH(DGMORE)
IF (DGOLDLN?1.P!('$LENGTH(DGOLDLN)))
Begin DoDot:2
+33 SET DGLN=DGLN+1
SET DGARRY(DGLN)=DGMORE
SET DGMORE=""
+34 if $LENGTH(DGOLDLN)
SET DGLN=DGLN+1
SET DGARRY(DGLN)=DGOLDLN
End DoDot:2
QUIT
+35 ;
+36 if $LENGTH(DGMORE)
SET DGOLDLN=DGMORE_" "_DGOLDLN
SET DGMORE=""
+37 ;
+38 IF $LENGTH(DGOLDLN)>DGMAX
FOR
Begin DoDot:2
+39 SET DGSPOT=$LENGTH($EXTRACT(DGOLDLN,1,DGMAX)," ")
+40 SET DGNEWLN=$PIECE(DGOLDLN," ",1,$SELECT(DGSPOT>1:DGSPOT-1,1:1))
+41 SET DGLN=DGLN+1
SET DGARRY(DGLN)=DGNEWLN
SET DGNEWLN=""
+42 SET DGMORE=$PIECE(DGOLDLN," ",$SELECT(DGSPOT>1:DGSPOT,1:DGSPOT+1),$LENGTH(DGOLDLN," "))
+43 IF $LENGTH(DGMORE)>DGMAX
SET DGOLDLN=DGMORE
SET DGMORE=""
+44 IF '$TEST
SET DGOLDLN=""
End DoDot:2
if '$LENGTH(DGOLDLN)
QUIT
+45 IF '$TEST
Begin DoDot:2
+46 SET DGLN=DGLN+1
SET DGARRY(DGLN)=DGOLDLN
End DoDot:2
End DoDot:1
+47 ;
+48 IF $DATA(DGARRY)
KILL DGTEXT
MERGE DGTEXT=DGARRY
+49 QUIT
