| [613] | 1 | DGPFRPI1 ;ALB/RBS - PRF PRINCIPAL INVEST REPORT CONT. ; 6/8/04 5:07pm
|
|---|
| 2 | ;;5.3;Registration;**554**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ;This routine will be used to display/print all patient assignments
|
|---|
| 5 | ;for a Principal Investigator assigned to the Research record flag.
|
|---|
| 6 | ;
|
|---|
| 7 | ; Input: DGSORT() - Array containing user report parameters.
|
|---|
| 8 | ;
|
|---|
| 9 | ; Output: A formatted report of the Principal Investigator person's
|
|---|
| 10 | ; associated patient record flag assignments.
|
|---|
| 11 | ;
|
|---|
| 12 | ;- no direct entry
|
|---|
| 13 | QUIT
|
|---|
| 14 | ;
|
|---|
| 15 | START ; compile and print report
|
|---|
| 16 | ;
|
|---|
| 17 | I $E(IOST)="C" D WAIT^DICD
|
|---|
| 18 | N DGLIST ;temp global name used for report list
|
|---|
| 19 | S DGLIST=$NA(^TMP("DGPFRPI1",$J))
|
|---|
| 20 | K @DGLIST
|
|---|
| 21 | D LOOP(.DGSORT,DGLIST)
|
|---|
| 22 | D PRINT^DGPFRPI2(.DGSORT,DGLIST)
|
|---|
| 23 | K @DGLIST
|
|---|
| 24 | D EXIT
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | LOOP(DGSORT,DGLIST) ;use sort var's for record searching to build list
|
|---|
| 28 | ; Input:
|
|---|
| 29 | ; DGSORT - array of user selected report parameters
|
|---|
| 30 | ; DGLIST - temp global name
|
|---|
| 31 | ;
|
|---|
| 32 | ; Output:
|
|---|
| 33 | ; ^TMP("DGPFRPI1",$J) - temp global containing report output
|
|---|
| 34 | ;
|
|---|
| 35 | N DGAIEN ;patient assignment ien
|
|---|
| 36 | N DGBEG ;sort beginning date
|
|---|
| 37 | N DGCNT ;flag counter
|
|---|
| 38 | N DGDFNLST ;array of patient dfn's assigned to the flag
|
|---|
| 39 | N DGEND ;sort ending date
|
|---|
| 40 | N DGFIEN ;flag ien
|
|---|
| 41 | N DGFLAG ;local array used to hold flag record
|
|---|
| 42 | N DGPI ;principal investigator person ien
|
|---|
| 43 | N DGPIIEN ;sort selection var
|
|---|
| 44 | N DGPINAME ;name of principal investigator
|
|---|
| 45 | N DGPINUM ;subscript number for principal investigator
|
|---|
| 46 | N DGPRINC ;principal investigator sort
|
|---|
| 47 | N DGSTAT ;status of assignment
|
|---|
| 48 | N DGSTATUS ;sort status
|
|---|
| 49 | N DGSUB ;loop flag name var
|
|---|
| 50 | N DGVPTR ;variable pointer of flag record (i.e.) "25;DGPF(26.11,"
|
|---|
| 51 | N DGX ;loop var
|
|---|
| 52 | ;
|
|---|
| 53 | ; setup variables equal to user input parameter subscripts
|
|---|
| 54 | ; Only Category II (Local) ^DGPF(26.11) file for Research Flags
|
|---|
| 55 | ; "DGPRINC", "DGSTATUS", "DGBEG", "DGEND"
|
|---|
| 56 | S DGX="" F S DGX=$O(DGSORT(DGX)) Q:DGX="" S @DGX=DGSORT(DGX)
|
|---|
| 57 | ;
|
|---|
| 58 | S DGPIIEN=+DGPRINC ; if 0, then 'A'll PI sort was selected
|
|---|
| 59 | S DGSTAT=+DGSTATUS
|
|---|
| 60 | S:DGSTAT=2 DGSTAT=0 ; inactive assignment status value is '0'
|
|---|
| 61 | ;
|
|---|
| 62 | ; loop research type (2) record flag x-ref
|
|---|
| 63 | S DGSUB="",DGCNT=0
|
|---|
| 64 | F S DGSUB=$O(^DGPF(26.11,"ATYP",2,DGSUB)) Q:DGSUB="" D
|
|---|
| 65 | . S DGFIEN=""
|
|---|
| 66 | . F S DGFIEN=$O(^DGPF(26.11,"ATYP",2,DGSUB,DGFIEN)) Q:DGFIEN="" D
|
|---|
| 67 | . . K DGFLAG
|
|---|
| 68 | . . Q:'$$GETLF^DGPFALF(DGFIEN,.DGFLAG) ;local flag record data
|
|---|
| 69 | . . Q:DGPIIEN&'$D(^DGPF(26.11,DGFIEN,2,"B",DGPIIEN))
|
|---|
| 70 | . . S (DGPINUM,DGPI)=""
|
|---|
| 71 | . . F S DGPINUM=$O(DGFLAG("PRININV",DGPINUM)) Q:DGPINUM="" D
|
|---|
| 72 | . . . S DGPI=$P($G(DGFLAG("PRININV",DGPINUM,0)),U)
|
|---|
| 73 | . . . S DGPINAME=$P($G(DGFLAG("PRININV",DGPINUM,0)),U,2)
|
|---|
| 74 | . . . S:DGPINAME']"" DGPINAME="Missing Name"
|
|---|
| 75 | . . . S DGVPTR=DGFIEN_";DGPF(26.11," ; flag variable pointer setup
|
|---|
| 76 | . . . K DGDFNLST
|
|---|
| 77 | . . . S DGCNT=$$ASGNCNT^DGPFLF6(DGVPTR,.DGDFNLST) ;patient dfn list
|
|---|
| 78 | . . . Q:'DGCNT
|
|---|
| 79 | . . . D BLDTMP(DGBEG,DGEND,DGSTAT,DGPI,DGPINAME,.DGDFNLST,DGLIST)
|
|---|
| 80 | Q
|
|---|
| 81 | ;
|
|---|
| 82 | BLDTMP(DGBEG,DGEND,DGSTAT,DGPI,DGPINAME,DGDFNLST,DGLIST) ; list global builder
|
|---|
| 83 | ; Input:
|
|---|
| 84 | ; DGBEG - sort beginning date
|
|---|
| 85 | ; DGEND - sort ending date
|
|---|
| 86 | ; DGSTAT - status of assignment
|
|---|
| 87 | ; DGPI - principal investigator person ien
|
|---|
| 88 | ; DGPINAME - name of principal investigator
|
|---|
| 89 | ; DGDFNLST - array of patient dfn's assigned to the flag
|
|---|
| 90 | ; DGLIST - temp global name used for report list
|
|---|
| 91 | ;
|
|---|
| 92 | ; Output:
|
|---|
| 93 | ; ^TMP("DGPFRPI1",$J) - temp global containing report output
|
|---|
| 94 | ;
|
|---|
| 95 | N DGACTDT ;initial entry date
|
|---|
| 96 | N DGAIEN ;patient assignment ien
|
|---|
| 97 | N DGDFN ;pointer to patient being reported on
|
|---|
| 98 | N DGFGNM ;flag name
|
|---|
| 99 | N DGHIEN ;history assignment ien
|
|---|
| 100 | N DGINIT ;initial assignment date
|
|---|
| 101 | N DGPFA ;assignment data array
|
|---|
| 102 | N DGPFAH ;assignment history data array
|
|---|
| 103 | N DGLINE ;report detail line
|
|---|
| 104 | N DGPAT ;array of patient demographics
|
|---|
| 105 | N DGPNM ;patient name
|
|---|
| 106 | N DGREV ;review date
|
|---|
| 107 | ;
|
|---|
| 108 | S DGDFN=""
|
|---|
| 109 | F S DGDFN=$O(DGDFNLST(DGDFN)) Q:DGDFN="" D
|
|---|
| 110 | . S DGAIEN=$G(DGDFNLST(DGDFN))
|
|---|
| 111 | . Q:DGAIEN=""
|
|---|
| 112 | . K DGPFA
|
|---|
| 113 | . Q:'$$GETASGN^DGPFAA(DGAIEN,.DGPFA) ;get assignment data
|
|---|
| 114 | . Q:DGDFN'=$P(DGPFA("DFN"),U)
|
|---|
| 115 | . I DGSTAT'=3,+DGPFA("STATUS")'=DGSTAT Q ;not correct status
|
|---|
| 116 | . ; get last history record (most current)
|
|---|
| 117 | . K DGPFAH
|
|---|
| 118 | . S DGHIEN=$$GETLAST^DGPFAAH(DGAIEN)
|
|---|
| 119 | . Q:'DGHIEN
|
|---|
| 120 | . Q:'$$GETHIST^DGPFAAH(DGHIEN,.DGPFAH)
|
|---|
| 121 | . S DGINIT=+$$GETADT^DGPFAAH(DGAIEN) ;initial assignment date
|
|---|
| 122 | . Q:'DGINIT
|
|---|
| 123 | . ; check if assignment falls within the Begin and End dates
|
|---|
| 124 | . I DGINIT>DGBEG&($P(DGINIT,".")'>DGEND) D
|
|---|
| 125 | . . ; get patient demographics
|
|---|
| 126 | . . K DGPAT
|
|---|
| 127 | . . Q:'$$GETPAT^DGPFUT2(DGDFN,.DGPAT)
|
|---|
| 128 | . . S DGPNM=DGPAT("NAME")
|
|---|
| 129 | . . S:DGPNM']"" DGPNM="Missing Patient Name"
|
|---|
| 130 | . . S DGFGNM=$P(DGPFA("FLAG"),U,2)
|
|---|
| 131 | . . S:DGFGNM']"" DGFGNM="Missing Flag Name"
|
|---|
| 132 | . . S DGACTDT=$$FDATE^VALM1(+DGPFAH("ASSIGNDT"))
|
|---|
| 133 | . . S DGAIEN=+DGPFAH("ASSIGN")
|
|---|
| 134 | . . I +DGPFA("REVIEWDT") S DGREV=$$FDATE^VALM1(+DGPFA("REVIEWDT"))
|
|---|
| 135 | . . E S DGREV="N/A"
|
|---|
| 136 | . . S DGLINE=DGPAT("SSN")_U_$P(DGPFAH("ACTION"),U,2)_U_DGACTDT_U_DGREV_U_$P(DGPFA("STATUS"),U,2)
|
|---|
| 137 | . . ; - Flag Name, 0 node, IEN of Principal Investigator = PI Name
|
|---|
| 138 | . . S @DGLIST@(DGFGNM,0,DGPI)=DGPINAME
|
|---|
| 139 | . . ; - Flag Name, Pat Name, DFN, Asignment IEN
|
|---|
| 140 | . . S @DGLIST@(DGFGNM,DGPNM,DGDFN,DGAIEN)=DGLINE
|
|---|
| 141 | Q
|
|---|
| 142 | ;
|
|---|
| 143 | EXIT ;
|
|---|
| 144 | I $D(ZTQUEUED) S ZTREQ="@"
|
|---|
| 145 | I '$D(ZTQUEUED) D
|
|---|
| 146 | . K %ZIS,POP
|
|---|
| 147 | . D ^%ZISC,HOME^%ZIS
|
|---|
| 148 | Q
|
|---|
