source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPHIST.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: 4.3 KB
Line 
1DGPHIST ;WASH/ERC - PURPLE HEART REQUEST HISTORY ;23 AUG 00
2 ;;5.3;Registration;**343**,Aug 13, 1993
3 ;
4 ;This report will show the Purple Heart Request history on a patient
5 Q
6 ;
7EN ;Entry point
8 N DGDFN,DGPAT,DGNAM,DGSSN
9 S DGDFN=$$GETDFN()
10 Q:DGDFN'>0
11 S DGPAT=$$GETPAT(DGDFN)
12 Q:$P(DGPAT,U)=""
13 S DGNAM=$P(DGPAT,U),DGSSN=$P(DGPAT,U,2)
14 I '$$PH(DGDFN) D Q
15 . W !!,"There is no Purple Heart history for patient "_$G(DGNAM)_"."
16 . W !
17 . I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR K DIR
18 I $$DEVICE() D START
19 D EXIT
20 Q
21 ;
22GETDFN() ;Ask the user to select patient
23 ;
24 ; Input: none
25 ;
26 ; Output: DFN
27 ;
28 N DIC,X,Y
29 S DIC="^DPT(",DIC(0)="AEMQ"
30 D ^DIC
31 Q $S(+Y>0:+Y,1:0)
32 ;
33GETPAT(DFN) ; get patient name and ssn
34 ;
35 ; Input: DFN - patient IEN
36 ;
37 ; Output:
38 ; Function value: patient name^SSN
39 ;
40 N VADM,DGNAM,DGSSN
41 S (DGNAM,DGSSN)=""
42 I $G(DFN)>0 D
43 . D ^VADPT
44 . S DGNAM=VADM(1)
45 . S DGSSN=$P(VADM(2),U,2)
46 Q DGNAM_"^"_DGSSN
47 ;
48PH(DGDFN1) ; does patient PH history exist
49 ;
50 ; Input: DGDFN1 - Patient IEN
51 ;
52 ; Output:
53 ; Function value: 0 - No PH Status history
54 ; >0 - History exists
55 ;
56 Q $P($G(^DPT(DGDFN1,"PH",0)),U,3)>0
57 ;
58DEVICE() ;select output device
59 ;
60 ; Input: none
61 ;
62 ; Output: Function value Interpretation
63 ; 0 User decides to queue or not print report.
64 ; 1 Device selected to generate report NOW.
65 ;
66 N OK,IOP,POP,%ZIS
67 S OK=1
68 S %ZIS="MQ"
69 D ^%ZIS
70 S:POP OK=0
71 I OK,$D(IO("Q")) D
72 . N ZTRTN,ZTDESC,ZTSAVE,ZTSK
73 . S ZTRTN="START^DGPHIST"
74 . S ZTDESC="Current PH Status Pending/In Process report."
75 . S ZTSAVE("DGDFN")=""
76 . S ZTSAVE("DGNAM")=""
77 . S ZTSAVE("DGSSN")=""
78 . F DG1=1:1:20 D ^%ZTLOAD Q:$G(ZTSK)
79 . W !,$S($D(ZTSK):"Request "_ZTSK_" Queued!",1:"Request Cancelled!"),!
80 . D HOME^%ZIS
81 . S OK=0
82 Q OK
83 ;
84START ;
85 U IO
86 N DGSITE,DGSTNUM,DGSTN,DGSTTN,DGDTN
87 S DGSITE=$$SITE^VASITE
88 S DGSTNUM=$P(DGSITE,U,3),DGSTN=$P(DGSITE,U,2)
89 S DGSTTN=$$NAME^VASITE(DT)
90 S DGDTN=$S($G(DGSTTN)]"":DGSTTN,1:$G(DGSTN))
91 D DATA
92 D EXIT
93 Q
94 ;
95DATA ;Build line data and print
96 ;
97 ; Division name retrieved from pointer to the INSTITUTION file (#4)
98 ; in PH DIVISION field (#.535) of PATIENT file (#2).
99 ; DBIA: #10090 - Supported read to the INSTITUTION file with FileMan
100 ;
101 N DGLINE,DGDATE,DGIND,DGSTAT,DGREM,DGUSER
102 N DGQUIT,DGPAGE,DGDIV
103 N DG1,DG2
104 S (DGPAGE,DGQUIT)=0
105 S DGDIV=$$GET1^DIQ(2,DGDFN,.535)
106 D HEAD
107 S DG1=0
108 F S DG1=$O(^DPT(DGDFN,"PH",DG1)) Q:DG1'>0 D
109 . S DGLINE(DG1)=^DPT(DGDFN,"PH",DG1,0)
110 S DG2=0
111 F S DG2=$O(DGLINE(DG2)) Q:DG2'>0 D
112 . D:$Y>(IOSL-4) HEAD Q:DGQUIT
113 . S DGDATE=$P($P(DGLINE(DG2),U),".")
114 . S DGDATE=$E(DGDATE,4,5)_"/"_$E(DGDATE,6,7)_"/"_$E(($E(DGDATE,1,3)+1700),3,4)
115 . S DGIND=$P(DGLINE(DG2),U,2)
116 . S DGIND=$S($G(DGIND)="Y":"Yes",$G(DGIND)="N":"No",1:"Unk")
117 . S DGSTAT=$P(DGLINE(DG2),U,3)
118 . S DGSTAT=$S($G(DGSTAT)="1":"Pending",$G(DGSTAT)="2":"In Process",$G(DGSTAT)="3":"Confirmed",1:"")
119 . S DGREM=$P(DGLINE(DG2),U,4)
120 . S DGREM=$S($G(DGREM)=1:"UNACCEPTABLE DOCUMENTATION",$G(DGREM)=2:"NO DOCUMENTATION REC'D",$G(DGREM)=3:"ENTERED IN ERROR",$G(DGREM)=4:"UNSUPPORTED PURPLE HEART",$G(DGREM)=5:"VAMC",$G(DGREM)=6:"UNDELIVERABLE MAIL",1:"")
121 . S DGUSER=$P(DGLINE(DG2),U,5)
122 . I $G(DGSTAT)["2"!($G(DGSTAT)["3") S DGUSER="HEC User"
123 . I $G(DGREM)]"",($G(DGREM)'["VAMC") S DGUSER="HEC User"
124 . W !,$G(DGDATE),?10,$G(DGIND),?15,$G(DGSTAT),?27,$G(DGREM),?55,$E($G(DGUSER),1,24)
125 W !!?30,"End of Report."
126 W !
127 I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR K DIR
128 Q
129HEAD ; page header
130 N DGDT
131 I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQUIT)=1 Q
132 I $G(DGPAGE)>0 I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQUIT=1
133 Q:DGQUIT
134 W @IOF
135 S Y=DT X ^DD("DD") S DGDT=Y
136 S DGPAGE=$G(DGPAGE)+1
137 W !!,"PURPLE HEART REQUEST HISTORY REPORT",?48,DGDT,?70,"Page: ",$G(DGPAGE)
138 W !,"STATION: "_$G(DGSTN)
139 I DGDIV]"" W !,"DIVISION: ",DGDIV
140 W !,"_____________________________________________________________________________"
141 W !!,"Patient Name: "_$G(DGNAM),?55,"SSN: "_$G(DGSSN)
142 W !,"-----------------------------------------------------------------------------"
143 W !!,"Date",?10,"PH?",?15,"Status",?27,"Remarks",?55,"Updated By"
144 W !,"--------",?10,"---",?15,"----------",?27,"--------------------------",?55,"---------------"
145 Q
146 ;
147EXIT ;
148 I $D(ZTQUEUED) S ZTREQ="@"
149 I '$D(ZTQUEUED) D
150 . K %ZIS,POP
151 . D ^%ZISC,HOME^%ZIS
152 Q
Note: See TracBrowser for help on using the repository browser.