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

DGPFRPI1.m

Go to the documentation of this file. 
  1. DGPFRPI1 ;ALB/RBS - PRF PRINCIPAL INVEST REPORT CONT. ; 6/8/04 5:07pm
  1.  ;;5.3;Registration;**554,1015**;Aug 13, 1993;Build 21
  1.  ;
  1.  ;This routine will be used to display/print all patient assignments
  1.  ;for a Principal Investigator assigned to the Research record flag.
  1.  ;
  1.  ; Input:   DGSORT() - Array containing user report parameters.
  1.  ;
  1.  ; Output:  A formatted report of the Principal Investigator person's
  1.  ;          associated patient record flag assignments.
  1.  ;
  1.  ;- no direct entry
  1.  QUIT
  1.  ;
  1. START ; compile and print report
  1.  ;
  1.  I $E(IOST)="C" D WAIT^DICD
  1.  N DGLIST ;temp global name used for report list
  1.  S DGLIST=$NA(^TMP("DGPFRPI1",$J))
  1.  K @DGLIST
  1.  D LOOP(.DGSORT,DGLIST)
  1.  D PRINT^DGPFRPI2(.DGSORT,DGLIST)
  1.  K @DGLIST
  1.  D EXIT
  1.  Q
  1.  ;
  1. LOOP(DGSORT,DGLIST) ;use sort var's for record searching to build list
  1.  ;  Input:
  1.  ;      DGSORT - array of user selected report parameters
  1.  ;      DGLIST - temp global name
  1.  ;
  1.  ; Output:
  1.  ;      ^TMP("DGPFRPI1",$J) - temp global containing report output
  1.  ;
  1.  N DGAIEN   ;patient assignment ien
  1.  N DGBEG    ;sort beginning date
  1.  N DGCNT    ;flag counter
  1.  N DGDFNLST ;array of patient dfn's assigned to the flag
  1.  N DGEND    ;sort ending date
  1.  N DGFIEN   ;flag ien
  1.  N DGFLAG   ;local array used to hold flag record
  1.  N DGPI     ;principal investigator person ien
  1.  N DGPIIEN  ;sort selection var
  1.  N DGPINAME ;name of principal investigator
  1.  N DGPINUM  ;subscript number for principal investigator
  1.  N DGPRINC  ;principal investigator sort
  1.  N DGSTAT   ;status of assignment
  1.  N DGSTATUS ;sort status
  1.  N DGSUB    ;loop flag name var
  1.  N DGVPTR   ;variable pointer of flag record (i.e.) "25;DGPF(26.11,"
  1.  N DGX      ;loop var
  1.  ;
  1.  ; setup variables equal to user input parameter subscripts
  1.  ; Only Category II (Local) ^DGPF(26.11) file for Research Flags
  1.  ;   "DGPRINC", "DGSTATUS", "DGBEG", "DGEND"
  1.  S DGX="" F  S DGX=$O(DGSORT(DGX)) Q:DGX=""  S @DGX=DGSORT(DGX)
  1.  ;
  1.  S DGPIIEN=+DGPRINC  ; if 0, then 'A'll PI sort was selected
  1.  S DGSTAT=+DGSTATUS
  1.  S:DGSTAT=2 DGSTAT=0  ; inactive assignment status value is '0'
  1.  ;
  1.  ; loop research type (2) record flag x-ref
  1.  S DGSUB="",DGCNT=0
  1.  F  S DGSUB=$O(^DGPF(26.11,"ATYP",2,DGSUB)) Q:DGSUB=""  D
  1.  . S DGFIEN=""
  1.  . F  S DGFIEN=$O(^DGPF(26.11,"ATYP",2,DGSUB,DGFIEN)) Q:DGFIEN=""  D
  1.  . . K DGFLAG
  1.  . . Q:'$$GETLF^DGPFALF(DGFIEN,.DGFLAG)  ;local flag record data
  1.  . . Q:DGPIIEN&'$D(^DGPF(26.11,DGFIEN,2,"B",DGPIIEN))
  1.  . . S (DGPINUM,DGPI)=""
  1.  . . F  S DGPINUM=$O(DGFLAG("PRININV",DGPINUM)) Q:DGPINUM=""  D
  1.  . . . S DGPI=$P($G(DGFLAG("PRININV",DGPINUM,0)),U)
  1.  . . . S DGPINAME=$P($G(DGFLAG("PRININV",DGPINUM,0)),U,2)
  1.  . . . S:DGPINAME']"" DGPINAME="Missing Name"
  1.  . . . S DGVPTR=DGFIEN_";DGPF(26.11,"  ; flag variable pointer setup
  1.  . . . K DGDFNLST
  1.  . . . S DGCNT=$$ASGNCNT^DGPFLF6(DGVPTR,.DGDFNLST)  ;patient dfn list
  1.  . . . Q:'DGCNT
  1.  . . . D BLDTMP(DGBEG,DGEND,DGSTAT,DGPI,DGPINAME,.DGDFNLST,DGLIST)
  1.  Q
  1.  ;
  1. BLDTMP(DGBEG,DGEND,DGSTAT,DGPI,DGPINAME,DGDFNLST,DGLIST) ; list global builder
  1.  ;  Input:
  1.  ;      DGBEG    - sort beginning date
  1.  ;      DGEND    - sort ending date
  1.  ;      DGSTAT   - status of assignment
  1.  ;      DGPI     - principal investigator person ien
  1.  ;      DGPINAME - name of principal investigator
  1.  ;      DGDFNLST - array of patient dfn's assigned to the flag
  1.  ;      DGLIST   - temp global name used for report list
  1.  ;
  1.  ; Output:
  1.  ;      ^TMP("DGPFRPI1",$J) - temp global containing report output
  1.  ;
  1.  N DGACTDT ;initial entry date
  1.  N DGAIEN  ;patient assignment ien
  1.  N DGDFN   ;pointer to patient being reported on
  1.  N DGFGNM  ;flag name
  1.  N DGHIEN  ;history assignment ien
  1.  N DGINIT  ;initial assignment date
  1.  N DGPFA   ;assignment data array
  1.  N DGPFAH  ;assignment history data array
  1.  N DGLINE  ;report detail line
  1.  N DGPAT   ;array of patient demographics
  1.  N DGPNM   ;patient name
  1.  N DGREV   ;review date
  1.  ;
  1.  S DGDFN=""
  1.  F  S DGDFN=$O(DGDFNLST(DGDFN)) Q:DGDFN=""  D
  1.  . S DGAIEN=$G(DGDFNLST(DGDFN))
  1.  . Q:DGAIEN=""
  1.  . K DGPFA
  1.  . Q:'$$GETASGN^DGPFAA(DGAIEN,.DGPFA)  ;get assignment data
  1.  . Q:DGDFN'=$P(DGPFA("DFN"),U)
  1.  . I DGSTAT'=3,+DGPFA("STATUS")'=DGSTAT Q  ;not correct status
  1.  . ; get last history record (most current)
  1.  . K DGPFAH
  1.  . S DGHIEN=$$GETLAST^DGPFAAH(DGAIEN)
  1.  . Q:'DGHIEN
  1.  . Q:'$$GETHIST^DGPFAAH(DGHIEN,.DGPFAH)
  1.  . S DGINIT=+$$GETADT^DGPFAAH(DGAIEN)  ;initial assignment date
  1.  . Q:'DGINIT
  1.  . ; check if assignment falls within the Begin and End dates
  1.  . I DGINIT>DGBEG&($P(DGINIT,".")'>DGEND) D
  1.  . . ; get patient demographics
  1.  . . K DGPAT
  1.  . . Q:'$$GETPAT^DGPFUT2(DGDFN,.DGPAT)
  1.  . . S DGPNM=DGPAT("NAME")
  1.  . . S:DGPNM']"" DGPNM="Missing Patient Name"
  1.  . . S DGFGNM=$P(DGPFA("FLAG"),U,2)
  1.  . . S:DGFGNM']"" DGFGNM="Missing Flag Name"
  1.  . . S DGACTDT=$$FDATE^VALM1(+DGPFAH("ASSIGNDT"))
  1.  . . S DGAIEN=+DGPFAH("ASSIGN")
  1.  . . I +DGPFA("REVIEWDT") S DGREV=$$FDATE^VALM1(+DGPFA("REVIEWDT"))
  1.  . . E  S DGREV="N/A"
  1.  . . S DGLINE=DGPAT("SSN")_U_$P(DGPFAH("ACTION"),U,2)_U_DGACTDT_U_DGREV_U_$P(DGPFA("STATUS"),U,2)
  1.  . . ; - Flag Name, 0 node, IEN of Principal Investigator = PI Name
  1.  . . S @DGLIST@(DGFGNM,0,DGPI)=DGPINAME
  1.  . . ; - Flag Name, Pat Name, DFN, Asignment IEN
  1.  . . S @DGLIST@(DGFGNM,DGPNM,DGDFN,DGAIEN)=DGLINE
  1.  Q
  1.  ;
  1. EXIT ;
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  I '$D(ZTQUEUED) D
  1.  . K %ZIS,POP
  1.  . D ^%ZISC,HOME^%ZIS
  1.  Q