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

DGPFLMT4.m

Go to the documentation of this file. 
  1. DGPFLMT4 ;ALB/RBS - PRF TRANSMIT VIEW MESSAGE BUILD LIST AREA ; 10/19/06 10:59am
  1.  ;;5.3;Registration;**650,1015**;Aug 13, 1993;Build 21
  1.  ;
  1.  ;no direct entry
  1.  QUIT
  1.  ;
  1.  ;
  1. EN(DGARY,DGPFIEN,DGCNT) ;Entry point to build error detail list area.
  1.  ;
  1.  ;  Input:
  1.  ;      DGARY - subscript name for temp global
  1.  ;    DGPFIEN - IEN of record
  1.  ;
  1.  ; Output:
  1.  ;      DGCNT - number of display lines, pass by reference (VALMCNT)
  1.  ;
  1.  ;quit if required input paramater not passed
  1.  Q:'$G(DGPFIEN)
  1.  ;
  1.  S:$G(DGARY)="" DGARY="DGPFVDET"
  1.  ;
  1.  N DGAIEN   ;assignment ien
  1.  N DGCOD    ;error code
  1.  N DGLI     ;dialog text line number
  1.  N DGPFA    ;assignment array
  1.  N DGPFAH   ;assignment history data array
  1.  N DGPFL    ;HL7 transmission log data array
  1.  N DGLINE   ;line counter
  1.  N DGSUB    ;subscript var
  1.  N DGPFL    ;HL7 transmission log data array
  1.  N DIERR    ;var returned from BLD^DIALOG
  1.  N DGTBL    ;error code table array
  1.  N DGTEMP   ;array returned from BLD^DIALOG with error msg text
  1.  ;
  1.  ;init variables
  1.  S DGLINE=0
  1.  K DGPFA,DGPFAH,DGPFL,DGTBL
  1.  ;
  1.  ;retrieve HL7 log data
  1.  Q:'$$GETLOG^DGPFHLL(DGPFIEN,.DGPFL)
  1.  Q:'+DGPFL("ASGNHIST")
  1.  ;retrieve assignment history data to get PRF Assignment ien
  1.  Q:'$$GETHIST^DGPFAAH(+DGPFL("ASGNHIST"),.DGPFAH)
  1.  S DGAIEN=$P($G(DGPFAH("ASSIGN")),U,1)
  1.  Q:'DGAIEN
  1.  Q:'$$GETASGN^DGPFAA(DGAIEN,.DGPFA)
  1.  ;
  1.  ;set Error Received D/T
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGPFLMT1(DGARY,DGLINE,"Error Received D/T: "_$$FDTTM^VALM1($P($G(DGPFL("ACKDT")),U,1)),10,,,.DGCNT)
  1.  ;
  1.  ;set Message Control ID
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGPFLMT1(DGARY,DGLINE,"Message Control ID: "_$P($G(DGPFL("MSGID")),U,2),10,,,.DGCNT)
  1.  ;
  1.  ;set Flag Name
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGPFLMT1(DGARY,DGLINE,"Flag Name: "_$P($G(DGPFA("FLAG")),U,2),19,,,.DGCNT)
  1.  ;
  1.  ;set Owner Site
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGPFLMT1(DGARY,DGLINE,"Owner Site: "_$P($G(DGPFA("OWNER")),U,2),18,,,.DGCNT)
  1.  ;
  1.  ;set Assignment Transmitted To
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGPFLMT1(DGARY,DGLINE,"Assignment Transmitted To: "_$P($G(DGPFL("SITE")),U,2),3,,,.DGCNT)
  1.  ;
  1.  ;set Assignment Transmission Date/Time
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGPFLMT1(DGARY,DGLINE,"Assignment Transmission D/T: "_$$FDTTM^VALM1($P($G(DGPFL("TRANSDT")),U,1)),1,,,.DGCNT)
  1.  ;
  1.  ;set blank line
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGPFLMT1(DGARY,DGLINE," ",1,,,.DGCNT)
  1.  ;
  1.  ;set Rejection Reason
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGPFLMT1(DGARY,DGLINE,"Rejection Reason(s): ",1,,,.DGCNT)
  1.  ;
  1.  ;set underline
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGPFLMT1(DGARY,DGLINE,"--------------------",1,,,.DGCNT)
  1.  ;
  1.  ;set no error code message
  1.  I $O(DGPFL("ERROR",""))="" D  Q 
  1.  . S DGLINE=DGLINE+1
  1.  . D SET^DGPFLMT1(DGARY,DGLINE,">>> There are no Rejection Reason codes on file.",1,,,.DGCNT)
  1.  ;
  1.  ;load error code table
  1.  D BLDVA086^DGPFHLU3(.DGTBL)
  1.  ;
  1.  ;loop and set error msg text lines
  1.  S DGSUB=0
  1.  F  S DGSUB=$O(DGPFL("ERROR",DGSUB)) Q:'DGSUB  D
  1.  . Q:$G(DGPFL("ERROR",DGSUB))']""
  1.  . K DGTEMP
  1.  . S DGCOD=DGPFL("ERROR",DGSUB)
  1.  . ;assume numeric error code is a DIALOG
  1.  . I DGCOD?1N.N D BLD^DIALOG(DGCOD,"","","DGTEMP")
  1.  . I $D(DGTEMP) D FORMAT(.DGTEMP,70)
  1.  . ;if not a DIALOG, then is it a table entry?
  1.  . I '$D(DGTEMP),DGCOD]"",$D(DGTBL(DGCOD,"DESC")) S DGTEMP(1)=DGTBL(DGCOD,"DESC") D FORMAT(.DGTEMP,70)
  1.  . ;not a DIALOG or table entry - then error is unknown
  1.  . I '$D(DGTEMP) S DGTEMP(1)="Unknown Error code: '"_DGCOD_"'"
  1.  . ;
  1.  . F DGLI=1:1 Q:'$D(DGTEMP(DGLI))  S DGLINE=DGLINE+1 D
  1.  . . I DGLI=1 D SET^DGPFLMT1(DGARY,DGLINE,DGSUB_". "_DGTEMP(DGLI),1,,,.DGCNT)
  1.  . . E  D SET^DGPFLMT1(DGARY,DGLINE,"   "_DGTEMP(DGLI),1,,,.DGCNT)
  1.  ;
  1.  Q
  1.  ;
  1. FORMAT(DGTEXT,DGMAX) ;format text lines to length
  1.  ;This procedure formats an array of text lines to be less than a
  1.  ;given maximum length.
  1.  ;
  1.  ;  Supported DBIA:  #10104 - $$TRIM^XLFSTR Kernel api to trim spaces
  1.  ;
  1.  ;  Input:
  1.  ;      DGTEXT - (required) array of text lines (passed by reference)
  1.  ;       DGMAX - (optional) maximum line length (default = 75)
  1.  ;
  1.  ; Output:
  1.  ;      DGTEXT - re-formatted array of text lines
  1.  ;
  1.  Q:'$D(DGTEXT)
  1.  ;
  1.  N DGARRY   ;temp array for re-formatting
  1.  N DGI      ;loop var
  1.  N DGLN     ;line counter var
  1.  N DGMORE   ;leftover words
  1.  N DGNEWLN  ;new text line
  1.  N DGOLDLN  ;original text line
  1.  N DGSPOT   ;position of text line to break at
  1.  ;
  1.  S:'+$G(DGMAX) DGMAX=75
  1.  ;
  1.  S (DGI,DGLN,DGMORE,DGNEWLN,DGOLDLN,DGSPOT)=""
  1.  ;
  1.  F DGI=1:1 S DGOLDLN=$G(DGTEXT(DGI)) Q:'$L(DGOLDLN)&'$L(DGMORE)  D
  1.  . I DGOLDLN'?1.P S DGOLDLN=$$TRIM^XLFSTR(DGOLDLN)
  1.  . I $L(DGOLDLN)'>DGMAX,'$L(DGMORE) D  Q
  1.  . . S DGLN=DGLN+1,DGARRY(DGLN)=DGOLDLN
  1.  . ;
  1.  . I $L(DGMORE),(DGOLDLN?1.P!('$L(DGOLDLN))) D  Q
  1.  . . S DGLN=DGLN+1,DGARRY(DGLN)=DGMORE,DGMORE=""
  1.  . . S:$L(DGOLDLN) DGLN=DGLN+1,DGARRY(DGLN)=DGOLDLN
  1.  . ;
  1.  . S:$L(DGMORE) DGOLDLN=DGMORE_" "_DGOLDLN,DGMORE=""
  1.  . ;
  1.  . I $L(DGOLDLN)>DGMAX F  D  Q:'$L(DGOLDLN)
  1.  . . S DGSPOT=$L($E(DGOLDLN,1,DGMAX)," ")
  1.  . . S DGNEWLN=$P(DGOLDLN," ",1,$S(DGSPOT>1:DGSPOT-1,1:1))
  1.  . . S DGLN=DGLN+1,DGARRY(DGLN)=DGNEWLN,DGNEWLN=""
  1.  . . S DGMORE=$P(DGOLDLN," ",$S(DGSPOT>1:DGSPOT,1:DGSPOT+1),$L(DGOLDLN," "))
  1.  . . I $L(DGMORE)>DGMAX S DGOLDLN=DGMORE,DGMORE=""
  1.  . . E  S DGOLDLN=""
  1.  . E  D
  1.  . . S DGLN=DGLN+1,DGARRY(DGLN)=DGOLDLN
  1.  ;
  1.  I $D(DGARRY) K DGTEXT M DGTEXT=DGARRY
  1.  Q