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

DGPFLFD1.m

Go to the documentation of this file. 
  1. DGPFLFD1 ;ALB/KCL - PRF DISPLAY FLAG DETAIL BUILD LIST AREA ; 6/9/04 2:49pm
  1.  ;;5.3;Registration;**425,554,1015**;Aug 13, 1993;Build 21
  1.  ;
  1.  ;no direct entry
  1.  QUIT
  1.  ;
  1. EN(DGARY,DGPFIEN,DGCNT) ;Entry point to build flag detail list area.
  1.  ;
  1.  ;  Input:
  1.  ;     DGARY - global array subscript
  1.  ;   DGPFIEN - IEN of record in PRF NATIONAL FLAG or PRF LOCAL
  1.  ;             FLAG file [ex: "1;DGPF(26.15,"]
  1.  ;
  1.  ; Output:
  1.  ;    DGCNT - number of lines in the list, pass by reference
  1.  ;
  1.  N DGPFF    ;flag array
  1.  N DGPFFH   ;flag history array
  1.  N DGFHIENS ;contains flag history ien's
  1.  N DGFHIEN  ;flag history ien
  1.  N DGHISCNT ;history record counter
  1.  N DGLINE   ;line counter
  1.  N DGSUB    ;subscript of flag history ien's
  1.  ;
  1.  ;quit if required input paramater not passed
  1.  Q:'$G(DGPFIEN)
  1.  ;
  1.  ;init variables
  1.  S (DGCNT,DGLINE,DGHISCNT)=0
  1.  K DGPFF
  1.  ;
  1.  ;get flag into DGPFF array
  1.  Q:'$$GETFLAG^DGPFUT1(DGPFIEN,.DGPFF)
  1.  S DGPFF("PTR")=DGPFIEN
  1.  ;
  1.  ;build 'Flag Details' list area
  1.  D FLAGDET(DGARY,.DGPFF,.DGLINE,.DGCNT)
  1.  ;
  1.  ;quit if NATIONAL flag, they don't have a history
  1.  Q:DGPFF("PTR")'["26.11"
  1.  ;
  1.  ;set history heading into list area
  1.  D HISTHDR(DGARY,.DGLINE,.DGCNT)
  1.  ;
  1.  ;get all history ien's associated with the flag
  1.  K DGFHIENS
  1.  Q:'$$GETALLDT^DGPFALH(+DGPFF("PTR"),.DGFHIENS)
  1.  ;
  1.  ;reverse loop through each flag history ien
  1.  S DGSUB=9999999.999999
  1.  F  S DGSUB=$O(DGFHIENS(DGSUB),-1) Q:DGSUB=""  D
  1.  . S DGFHIEN=$G(DGFHIENS(DGSUB))
  1.  . K DGPFFH
  1.  . ;- for each ien, get flag history into DGPFFH array
  1.  . I $$GETHIST^DGPFALH(DGFHIEN,.DGPFFH) D
  1.  . . ;
  1.  . . ;-- count of history records
  1.  . . S DGHISCNT=DGHISCNT+1
  1.  . . ;
  1.  . . ;-- build flag history details list area
  1.  . . D HISTDET(DGARY,.DGPFFH,.DGLINE,DGHISCNT,.DGCNT)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. FLAGDET(DGARY,DGPFF,DGLINE,DGCNT) ;This procedure will build the lines of FLAG details in the list area.
  1.  ;
  1.  ;  Input:
  1.  ;    DGARY - global array subscript
  1.  ;    DGPFF - flag array, pass by reference
  1.  ;   DGLINE - line counter
  1.  ;
  1.  ; Output:
  1.  ;    DGCNT - number of lines in the list, pass by reference
  1.  ;
  1.  ;temp vars used
  1.  N DGSUB   ;array subscript
  1.  N DGTEMP  ;temp text holder
  1.  N DGCOUNT ;principal investigator count
  1.  ;
  1.  ;set flag name
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGPFLF1(DGARY,DGLINE,"Flag Name: "_$P($G(DGPFF("FLAG")),U,2),11,,,,,.DGCNT)
  1.  ;
  1.  ;set flag category
  1.  S DGLINE=DGLINE+1
  1.  S DGTEMP=$S(DGPFF("PTR")["26.11":"II (LOCAL)",DGPFF("PTR")["26.15":"I (NATIONAL)",1:"UNKNOWN")
  1.  D SET^DGPFLF1(DGARY,DGLINE,"Flag Category: "_DGTEMP,7,,,,,.DGCNT)
  1.  ;
  1.  ;set flag type
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGPFLF1(DGARY,DGLINE,"Flag Type: "_$P($G(DGPFF("TYPE")),U,2),11,,,,,.DGCNT)
  1.  ;
  1.  ;set flag status
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGPFLF1(DGARY,DGLINE,"Flag Status: "_$P($G(DGPFF("STAT")),U,2),9,,,,,.DGCNT)
  1.  ;
  1.  ;set flag review frequency
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGPFLF1(DGARY,DGLINE,"Review Freq Days: "_$P($G(DGPFF("REVFREQ")),U,2),4,,,,,.DGCNT)
  1.  ;
  1.  ;set notification days
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGPFLF1(DGARY,DGLINE,"Notification Days: "_$P($G(DGPFF("NOTIDAYS")),U,2),3,,,,,.DGCNT)
  1.  ;
  1.  ;set flag review mail group
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGPFLF1(DGARY,DGLINE,"Review Mail Group: "_$P($G(DGPFF("REVGRP")),U,2),3,,,,,.DGCNT)
  1.  ;
  1.  ;set associated progress note title
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGPFLF1(DGARY,DGLINE,"Progress Note Title: "_$E($P($G(DGPFF("TIUTITLE")),U,2),1,59),1,,,,,.DGCNT)
  1.  ;
  1.  ;set if principal investigator(s)
  1.  I $D(DGPFF("PRININV")) D
  1.  . S (DGSUB,DGTEMP)=""
  1.  . S DGCOUNT=1
  1.  . F  S DGSUB=$O(DGPFF("PRININV",DGSUB)) Q:'DGSUB  D
  1.  . . Q:$G(DGPFF("PRININV",DGSUB,0))="@"
  1.  . . I DGCOUNT=1 D
  1.  . . . S DGLINE=DGLINE+1
  1.  . . . S DGTEMP="Principal"
  1.  . . . D SET^DGPFLF1(DGARY,DGLINE,DGTEMP,5,,,,,.DGCNT)
  1.  . . . S DGLINE=DGLINE+1
  1.  . . . S DGTEMP="Investigator(s): "_$P($G(DGPFF("PRININV",DGSUB,0)),U,2)
  1.  . . . D SET^DGPFLF1(DGARY,DGLINE,DGTEMP,5,,,,,.DGCNT)
  1.  . . I DGCOUNT>1 D
  1.  . . . S DGTEMP=$P($G(DGPFF("PRININV",DGSUB,0)),U,2)
  1.  . . . S DGLINE=DGLINE+1
  1.  . . . D SET^DGPFLF1(DGARY,DGLINE,DGTEMP,22,,,,,.DGCNT)
  1.  . . S DGCOUNT=DGCOUNT+1
  1.  ;
  1.  ;set flag description
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGPFLF1(DGARY,DGLINE,"",1,,,,,.DGCNT)
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGPFLF1(DGARY,DGLINE,"Flag Description:",1,IORVON,IORVOFF,,,.DGCNT)
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGPFLF1(DGARY,DGLINE,"-----------------",1,,,,,.DGCNT)
  1.  I '$D(DGPFF("DESC",1,0)) D  Q
  1.  . S DGLINE=DGLINE+1
  1.  . D SET^DGPFLF1(DGARY,DGLINE,"Unknown",1,,,,,.DGCNT)
  1.  S DGSUB=0,DGTEMP=""
  1.  F  S DGSUB=$O(DGPFF("DESC",DGSUB)) Q:'DGSUB  D
  1.  . S DGTEMP=$G(DGPFF("DESC",DGSUB,0))
  1.  . S DGLINE=DGLINE+1
  1.  . D SET^DGPFLF1(DGARY,DGLINE,DGTEMP,1,,,,,.DGCNT)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. HISTDET(DGARY,DGPFFH,DGLINE,DGHISCNT,DGCNT) ;This procedure will build the lines of FLAG HISTORY details in the list area.
  1.  ;
  1.  ;  Input:
  1.  ;     DGARY - global array subscript
  1.  ;    DGPFFH - flag history array, pass by reference
  1.  ;    DGLINE - line counter
  1.  ;  DGHISCNT - history record counter
  1.  ;
  1.  ; Output:
  1.  ;    DGCNT - number of lines in the list, pass by reference
  1.  ;
  1.  ;temporary variables used
  1.  N DGTEMP
  1.  N DGSUB
  1.  S DGTEMP=""
  1.  ;
  1.  ;set blank line
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGPFLF1(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^DGPFLF1(DGARY,DGLINE,"",1,,,,,.DGCNT)
  1.  ;
  1.  ;set history counter
  1.  S DGLINE=DGLINE+1
  1.  S DGTEMP=DGHISCNT_"."
  1.  D SET^DGPFLF1(DGARY,DGLINE,DGTEMP,1,IORVON,IORVOFF,,,.DGCNT)
  1.  ;
  1.  ;set edit date/time
  1.  D SET^DGPFLF1(DGARY,DGLINE,"Enter/Edit On: "_$$FDTTM^VALM1($P($G(DGPFFH("ENTERDT")),U)),14,IORVON,IORVOFF,,,.DGCNT)
  1.  ;
  1.  ;set entered by
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGPFLF1(DGARY,DGLINE,"Enter/Edit By: "_$P($G(DGPFFH("ENTERBY")),U,2),14,,,,,.DGCNT)
  1.  ;
  1.  ;set blank line
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGPFLF1(DGARY,DGLINE,"",1,,,,,.DGCNT)
  1.  ;
  1.  ;set edit reason text
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGPFLF1(DGARY,DGLINE,"Reason For Flag Enter/Edit:",1,,,,,.DGCNT)
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGPFLF1(DGARY,DGLINE,"---------------------------",1,,,,,.DGCNT)
  1.  I $D(DGPFFH("REASON",1,0)) D
  1.  . S DGSUB=0,DGTEMP=""
  1.  . F  S DGSUB=$O(DGPFFH("REASON",DGSUB)) Q:'DGSUB  D
  1.  .. S DGTEMP=$G(DGPFFH("REASON",DGSUB,0))
  1.  .. S DGLINE=DGLINE+1
  1.  .. D SET^DGPFLF1(DGARY,DGLINE,DGTEMP,1,,,,,.DGCNT)
  1.  E  D
  1.  . S DGLINE=DGLINE+1
  1.  . D SET^DGPFLF1(DGARY,DGLINE,"Unknown",1,,,,,.DGCNT)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. HISTHDR(DGARY,DGLINE,DGCNT) ;Set history heading into list area.
  1.  ;
  1.  ;  Input:
  1.  ;    DGARY - global array subscript
  1.  ;   DGLINE - line counter
  1.  ;
  1.  ; Output:
  1.  ;    DGCNT - number of lines in the list, pass by reference
  1.  ;
  1.  ;set blank line
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGPFLF1(DGARY,DGLINE,"",1,,,,,.DGCNT)
  1.  ;
  1.  ;set hist heading
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGPFLF1(DGARY,DGLINE,$TR($J("",80)," ","="),1,,,,,.DGCNT)
  1.  D SET^DGPFLF1(DGARY,DGLINE,"<Flag Enter/Edit History>",28,IORVON,IORVOFF,,,.DGCNT)
  1.  ;
  1.  Q