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

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

initial load of FOIAVistA 6/30/08 version
File size: 4.0 KB
Line 
1DGPFLMU ;ALB/KCL - PRF ASSIGNMENT LISTMAN UTILITIES ; 3/06/06 3:39pm
2 ;;5.3;Registration;**425,650**;Aug 13, 1993;Build 3
3 ;
4 ;no direct entry
5 QUIT
6 ;
7BLDHDR(DGDFN,DGPFHDR) ;This procedure builds the VALMHDR array to display the ListMan header.
8 ;
9 ; Supported DBIA #2701: The supported DBIA is used to access the
10 ; MPI functions to retrieve the ICN and CMOR.
11 ;
12 ; Input:
13 ; DGDFN - internal entry number of PATIENT (#2) file
14 ; DGPFHDR - header array passed by reference
15 ;
16 ; Output:
17 ; DGPFHDR - header array
18 ;
19 N DGCMOR ;CIRN Master of Record
20 N DGICN ;Integrated Control Number
21 N DGPFPAT ;Patient identifying info
22 ;
23 ;retrieve patient identifying info
24 I $$GETPAT^DGPFUT2(DGDFN,.DGPFPAT)
25 ;
26 ;set 1st line of header
27 S DGPFHDR(1)="Patient: "_$G(DGPFPAT("NAME"))_" "
28 S DGPFHDR(1)=$$SETSTR^VALM1("("_$G(DGPFPAT("SSN"))_")",DGPFHDR(1),$L(DGPFHDR(1))+1,80)
29 S DGPFHDR(1)=$$SETSTR^VALM1("DOB: "_$$FDATE^VALM1($G(DGPFPAT("DOB"))),DGPFHDR(1),54,80)
30 ;
31 ;set 2nd line of header
32 S DGICN=$$GETICN^MPIF001(DGDFN)
33 S DGICN=$S(DGICN<0:"No ICN for patient",1:DGICN)
34 S DGPFHDR(2)=" ICN: "_DGICN
35 S DGCMOR=$$CMOR2^MPIF001(DGDFN)
36 S DGCMOR=$S(DGCMOR<0:$P(DGCMOR,U,2),1:DGCMOR)
37 S DGCMOR="CMOR: "_DGCMOR
38 S DGPFHDR(2)=$$SETSTR^VALM1(DGCMOR,DGPFHDR(2),53,27)
39 Q
40 ;
41 ;
42BLDLIST(DGDFN) ;This procedure will build list of flag assignments for a patient for display in ListMan.
43 ;
44 ; Input:
45 ; DGDFN - internal entry number of PATIENT (#2) file
46 ;
47 ; Output: None
48 ;
49 N DGIEN ;ien of assignment
50 N DGIENS ;array of assignment ien's
51 N DGPFA ;assignment data array
52 N DGPFAH ;assignment history data array
53 N DGPTR ;pointer to last assignment history record
54 N DGTXT ;msg text if no assignments for patient
55 ;
56 ;kill data and video cntrl arrays associated with active list
57 D CLEAN^VALM10
58 ;
59 ;if no assignments, display msg, quit
60 K DGIENS
61 I '$$GETALL^DGPFAA(DGDFN,.DGIENS) D Q
62 . S DGTXT=" Selected patient has no record flag assignments on file."
63 . D SET^VALM10(1,"")
64 . D SET^VALM10(2,DGTXT)
65 . D CNTRL^VALM10(2,4,$L(DGTXT),$G(IOINHI),$G(IOINORM))
66 . S VALMCNT=2
67 ;
68 ;if assignments, get data and build list
69 S DGIEN=0,VALMCNT=0
70 F S DGIEN=$O(DGIENS(DGIEN)) Q:'DGIEN D
71 . ;-get assignment
72 . K DGPFA
73 . Q:'$$GETASGN^DGPFAA(DGIEN,.DGPFA)
74 . ;-get initial assignment history
75 . K DGPFAH
76 . Q:'$$GETHIST^DGPFAAH($$GETFIRST^DGPFAAH(DGIEN),.DGPFAH)
77 . ;-get 'initial assignment' date
78 . S DGPFAH("INITASSIGN")=$G(DGPFAH("ASSIGNDT"))
79 . Q:'DGPFAH("INITASSIGN")
80 . ;-increment line number count
81 . S VALMCNT=VALMCNT+1
82 . ;-build list
83 . D BLDLIN(VALMCNT,.DGPFA,.DGPFAH,DGIEN)
84 ;
85 Q
86 ;
87 ;
88BLDLIN(DGLNUM,DGPFA,DGPFAH,DGIEN) ;This procedure will build and setup ListMan lines and array.
89 ;
90 ; Input:
91 ; DGLNUM - line number
92 ; DGPFA - array containing assignment, passed by reference
93 ; DGPFAH - array containing assignment history, passed by reference
94 ; DGIEN - internal entry number of assignment
95 ;
96 ; Output: None
97 ;
98 N DGTXT ;used as temporary text field
99 N DGLINE ;string to insert field data
100 S DGLINE="" ;init
101 S DGLINE=$$SETSTR^VALM1(DGLNUM,DGLINE,1,3)
102 ;
103 ;flag name
104 S DGTXT=$P($G(DGPFA("FLAG")),U,2)
105 S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"FLAG")
106 ;
107 ;initial assignment date
108 S DGTXT=$$FDATE^VALM1(+$G(DGPFAH("INITASSIGN")))
109 S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"ASSIGN DATE")
110 ;
111 ;review date
112 S DGTXT=+$G(DGPFA("REVIEWDT"))
113 S DGTXT=$S(DGTXT:$$FDATE^VALM1(DGTXT),1:"N/A")
114 S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"REVIEW DATE")
115 ;
116 ;status/active (yes/no)
117 S DGTXT=$P($G(DGPFA("STATUS")),U)
118 S DGTXT=$S(DGTXT=1:"YES",1:"NO")
119 S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"STATUS")
120 ;
121 ;local (yes/no)
122 S DGTXT="NO"
123 I $P($G(DGPFA("FLAG")),U)["26.11" S DGTXT="YES"
124 S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"LOCAL")
125 ;
126 ;owner site
127 S DGTXT=$P($G(DGPFA("OWNER")),U,2)
128 S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"OWNER SITE")
129 ;
130 ;construct initial list array
131 D SET^VALM10(DGLNUM,DGLINE,DGLNUM)
132 ;
133 ;set assignment ien and pt DFN into index
134 S @VALMAR@("IDX",DGLNUM,DGLNUM)=$G(DGIEN)_U_+$G(DGPFA("DFN"))
135 ;
136 Q
Note: See TracBrowser for help on using the repository browser.