source: WorldVistAEHR/trunk/r/QUASAR-ACKQ/ACKQUTL7.m@ 1259

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

initial load of WorldVistAEHR

File size: 4.7 KB
Line 
1ACKQUTL7 ;HCIOFO/BH-Template Inquire - A&SP Patient/Visit ; 04/01/99
2 ;;3.0;QUASAR;**8**;Feb 11, 2000
3 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
4 ;
5 ;
6INP ; PRINT INPATIENT INFO
7 W !,"WARD: ",ACK(6),?20,"ROOM/BED: ",ACK(7),?40,"TREATING SPEC:"
8 W $E(ACK(8),1,25)
9 Q
10 ;
11 ;
12EN ; Get Demographics
13 N I,X,Y K ACKDIRUT
14 D DEM^VADPT,INP^VADPT,ELIG^VADPT
15 S ACKIVD=$$NUMDT^ACKQUTL($P(^ACK(509850.2,ACKPAT,0),U,2))
16 K ACK S ACK(1)=VADM(1),ACK(2)=$P(VADM(3),U,2),ACK(3)=$P(VADM(2),U,2)
17 S ACK(4)=VADM(7),ACK(6)=$P(VAIN(4),U,2)
18 S ACKINP=$S($L(ACK(6)):1,1:0),ACK(5)="Patient is "_$S(ACKINP:"",1:"not ")_"currently an inpatient."
19 S ACK(7)=VAIN(5),ACK(8)=$P(VAIN(3),U,2),ACK(9)=$P(VAEL(1),U,2)
20PRINT ;
21 W @IOF
22 S X="QUASAR V.3. "_ACKVISIT_" VISIT ENTRY" D CNTR^ACKQUTL(X)
23 ;
24 ;
25 D TPLTE
26 ;
27 ;
28 ; D RATDIS^ACKQNQ ; Display any Rated Disabilities
29 ;
30 W !!,"Patient Diagnostic History",!
31 W $S($P(VADM(5),U)="F":"Ms. ",1:"Mr. "),$P(VADM(1),",")
32 W " has been seen for the following:",!
33 I $Y>(IOSL-8) S DIR(0)="E" D ^DIR K DIR Q:$D(DIRUT) W @IOF
34 D DIHEAD,ICDSORT
35 K DIRUT W !
36 I '$O(ACKICD("")) W !,"No A&SP Diagnostic Data for this Patient" G EXIT
37 S ACKI=""
38 F S ACKI=$O(ACKICD(ACKI)) Q:ACKI="" D:$Y>(IOSL-5) WAIT Q:$D(DIRUT) W !,$P(ACKICD(ACKI),U),?15,$P(ACKICD(ACKI),U,3),?60,$$NUMDT^ACKQUTL($P(ACKICD(ACKI),U,4))
39EXIT ;
40 I $G(DIRUT)=1 S ACKDIRUT=1 ; Quit flag for template
41 W !!
42 K %ZIS,ACK,ACKDC,ACKDD,ACKDFN,ACKDN,ACKI,ACKICD,ACKINP,ACKIVD,ACKLINE
43 K ACKRD,DIRUT,DTOUT,DUOUT,VA,VADM,VAEL,VAERR,VAIN,X,X1,Y,ZTDESC,ZTIO
44 K ZTRTN,ZTSAVE
45 W:$E(IOST)'="C" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
46 Q
47 ;
48WAIT ;
49 K DIRUT I $E(IOST)'="C" W @IOF Q
50 S DIR(0)="E" D ^DIR K DIR Q:$D(DIRUT) W @IOF,"Patient Diagnostic History (Cont'd)"," (",ACK(1),")" D DIHEAD
51 Q
52DIHEAD ;
53 W !,"DIAGNOSIS",?60,"DATE ENTERED" S ACKLINE="",$P(ACKLINE,"-",IOM)="" W !,ACKLINE
54 Q
55ICDSORT ;
56 S ACKI=0 F S ACKI=$O(^ACK(509850.2,DFN,1,ACKI)) Q:'ACKI D
57 . S ACKDC=^ACK(509850.2,DFN,1,ACKI,0),ACKDD=$P(ACKDC,U,2)
58 . D GETS^DIQ(80,+ACKDC_",",".01;2","E","ACKTGT","ACKMSG")
59 . S ACKDN=ACKTGT(80,+ACKDC_",",.01,"E")
60 . S ACKICD(ACKDN)=ACKDN_U_ACKTGT(80,+ACKDC_",",2,"E")_U_$$DIAGTXT^ACKQUTL8(+ACKDC,ACKDD)_U_ACKDD
61 K ACKTGT,ACKMSG
62 Q
63 ;
64TPLTE ; Display Visit Clinic and Division
65 N ACKTMPE
66 W !!,"CLINIC: ",$$GET1^DIQ(509850.6,ACKVIEN,"2.6")
67 W ?45,"DIVISION: ",$$GET1^DIQ(509850.6,ACKVIEN,60),!
68 ; Display more Patient data
69 W "PATIENT: ",ACK(1),?45,"DOB: ",ACK(2),?63,"SSN: ",ACK(3)
70 ; If no Visit Eligibility on visit file display Primary Elig.
71 S ACKTMPE=$$GET1^DIQ(509850.6,ACKVIEN_",",80,"E")
72 I ACKTMPE D
73 . W !,"VISIT ELIGIBILITY: "_ACKTMPE
74 ;
75 I 'ACKTMPE D
76 .W !,"ELIGIBILITY: ",ACK(9)
77 W ?45,"INITIAL VISIT DATE: ",ACKIVD
78 W:$L(ACK(4)) !,ACK(4) W !,ACK(5) D:ACKINP INP
79 ; D VISIT
80 ;
81 Q
82 ;
83VISIT ; Displays Service connected data
84 ;
85 I 'ACKSC Q ; If Patient not service connected QUIT
86 I 'ACKPCE Q ; If system not set up for PCE then QUIT
87 ;
88 N ACKX,ACKVV,ACKPP,ACKVSC,ACKAAO,ACKEENV,ACKRRAD,ACK,ACKSTR
89 ;
90 D GETDATA
91 I ACKVISIT="NEW",$G(ACKPCENO)="" D UNKNOWN Q
92 I 'ACKVSC D NOT("This Visit's Treatment :",ACKAAO,ACKRRAD,ACKEENV) Q
93 I ACKVSC D CONNECT
94 Q
95 ;
96 ;
97GETDATA ; Get visit data
98 ;
99 K ACK
100 D GETS^DIQ(509850.6,ACKVIEN,"20;25;30;35","I","ACK")
101 S ACKVSC=ACK(509850.6,ACKVIEN_",",20,"I")
102 S ACKAAO=ACK(509850.6,ACKVIEN_",",25,"I")
103 S ACKEENV=ACK(509850.6,ACKVIEN_",",35,"I")
104 S ACKRRAD=ACK(509850.6,ACKVIEN_",",30,"I")
105 K ACK
106 Q
107 ;
108CONNECT W !!,"This visit's Treatment is Service Connected.",!
109 Q
110 ;
111NOT(ACKSTR,ACKAAO,ACKRRAD,ACKEENV) ;
112 W !!,ACKSTR,!
113 W "------------------------------------------------------------------------------"
114 ;
115 W !,"Related to AGENT ORANGE ? : "_$S(ACKAAO="1":"YES",1:"NO") W ?50,"Service Connected ? : NO"
116 ;
117 W !,"Related to RADIATION EXPOSURE ? : "_$S(ACKRRAD="1":"YES",1:"NO")
118 ;
119 W !,"Related to ENVIRONMENTAL CONTAMINANTS ? : "_$S(ACKEENV="1":"YES",1:"NO")
120 Q
121 ;
122UNKNOWN N ACKPASS
123 S ACKPASS=0
124 W !!,"This visit's Treatment:",!
125 W "------------------------------------------------------------------------------",!
126 I ACKAO W "Related to AGENT ORANGE ? : UNKNOWN" D:'ACKPASS SERV
127 I ACKRAD W !,"Related to RADIATION EXPOSURE ? : UNKNOWN" D:'ACKPASS SERV
128 I ACKENV W !,"Related to ENVIRONMENTAL CONTAMINANTS ? : UNKNOWN" D:'ACKPASS SERV
129 D:'ACKPASS SERV
130 W !
131 Q
132 ;
133SERV ;
134 W ?50,"Service Connected ? : UNKNOWN" S ACKPASS=1
135 Q
136 ;
137ERROR ; Display error message if registration returns error that indicates
138 ; that the Appointment Management database is not available.
139 ;
140 N ACKERR
141 W !!!!," ** The Appointment Management Data Base is unavailable. **"
142 W !!," ** Please report this problem to IRM as soon as possible. **",!!!
143 W " Press any key to continue."
144 R ACKERR:DTIME
145 ;
146 Q
147 ;
Note: See TracBrowser for help on using the repository browser.