source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPFRPI1.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.1 KB
Line 
1DGPFRPI1 ;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 ;
15START ; 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 ;
27LOOP(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 ;
82BLDTMP(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 ;
143EXIT ;
144 I $D(ZTQUEUED) S ZTREQ="@"
145 I '$D(ZTQUEUED) D
146 . K %ZIS,POP
147 . D ^%ZISC,HOME^%ZIS
148 Q
Note: See TracBrowser for help on using the repository browser.