source: FOIAVistA/tag/r/QUASAR-ACKQ/ACKQNQ.m@ 1767

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

initial load of FOIAVistA 6/30/08 version

File size: 5.2 KB
Line 
1ACKQNQ ;AUG/JLTP,AEM BIR/PTD HCIOFO/BH HCIOFO/AG-Inquire - A&SP Patient ; 04/01/99
2 ;;3.0;QUASAR;**8,14**;Feb 11, 2000;Build 14
3 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
4 ;
5OPTN ; Introduce option.
6 S ACKQUIT=0
7 W:$E(IOST,1,2)="C-" @IOF,!,"This option displays demographic data, inpatient status, and diagnostic",!,"history for a selected A&SP patient."
8 ;
9DIC ; LOOKUP PATIENT
10 N DIC
11 W ! S DIC=509850.2,DIC(0)="AEMQ" D ^DIC
12 I (Y<0)!($D(DUOUT)) S ACKQUIT=1 G EXIT
13 S ACKDFN=+Y
14 ;
15ASK ; Update patient's diagnostic history?
16 S DIR(0)="Y",DIR("A")="Do you want to update this patient's diagnostic history NOW",DIR("B")="NO",DIR("?")="Enter YES to recompile the Problem List; enter NO to continue."
17 S DIR("??")="^D UPDATE^ACKQHLP1" W ! D ^DIR K DIR G:$D(DIRUT) EXIT I Y=1 D UPDATE
18 ;
19DEV W !!,"The right margin for this report is 80.",!,"You can queue it to run at a later time.",!
20 K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED." G EXIT
21 I $D(IO("Q")) K IO("Q") S ZTRTN="EN^ACKQNQ",ZTSAVE("ACKDFN")="",ZTDESC="QUASAR - Inquire - A&SP Patient" D ^%ZTLOAD D HOME^%ZIS K ZTSK G EXIT
22 ;
23EN U IO N DFN,I,X,Y S DFN=ACKDFN
24 D DEM^VADPT,INP^VADPT,ELIG^VADPT
25 S ACKIVD=$$NUMDT^ACKQUTL($P(^ACK(509850.2,DFN,0),U,2))
26 K ACK S ACK(1)=VADM(1),ACK(2)=$P(VADM(3),U,2),ACK(3)=$P(VADM(2),U,2),ACK(4)=VADM(7),ACK(6)=$P(VAIN(4),U,2)
27 S ACKINP=$S($L(ACK(6)):1,1:0),ACK(5)="Patient is "_$S(ACKINP:"",1:"not ")_"currently an inpatient."
28 S ACK(7)=VAIN(5),ACK(8)=$P(VAIN(3),U,2),ACK(9)=$P(VAEL(1),U,2)
29 ;
30 ;
31PRINT W:$E(IOST,1,2)="C-" @IOF
32 D CNTR^ACKQUTL("Patient Inquiry")
33 ;
34 W !!
35 W "PATIENT: ",ACK(1),?45,"DOB: ",ACK(2),?63,"SSN: ",ACK(3)
36 W !,"ELIGIBILITY: ",ACK(9)
37 W ?45,"INITIAL VISIT DATE: ",ACKIVD
38 W:$L(ACK(4)) !,ACK(4) W !,ACK(5) D:ACKINP INP
39 ;
40 I $P(VAEL(3),U,1) W !!,"Patient is Service Connected."
41 I '$P(VAEL(3),U,1) D
42 . S ACKPAT=DFN D STATUS^ACKQUTL4 K VASV
43 . D NOT^ACKQUTL7("Patient is not Service Connected.",ACKAO,ACKRAD,ACKENV)
44 . K ACKPAT,ACKAO,ACKRAD,ACKENV
45 ;
46 D RATDIS G:$G(DIRUT) EXIT
47 D ICDSORT,DIAGHIST
48 ;
49EXIT I $G(ACKVISIT)'="",$G(DIRUT)=1 S ACKDIRUT=1 ; Quit flag for template
50 K %ZIS,ACK,ACKDC,ACKDD,ACKDFN,ACKDN,ACKI,ACKICD,ACKINP,ACKIVD,ACKLINE
51 K ACKRD,DIRUT,DTOUT,DUOUT,VA,VADM,VAEL,VAERR,VAIN,X,X1,Y,ZTDESC,ZTIO
52 K ZTRTN,ZTSAVE
53 I $G(ACKQUIT)=1 D KILL^%ZISS Q
54 I $E(IOST,1,2)="C-" W !!,"Press return to continue." R X:DTIME W @IOF
55 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
56 S ACKQUIT=0 G DIC
57 Q
58 ;
59EN1 ; CALL THIS ENTRY POINT INSTEAD OF EN
60 D HOME^%ZIS G EN
61 ;
62 ;
63INP ; PRINT INPATIENT INFO
64 W !,"WARD: ",ACK(6),?20,"ROOM/BED: ",ACK(7),?40,"TREATING SPEC: ",$E(ACK(8),1,25)
65 Q
66 ;
67 ;
68RATDIS ; Display Patients RATED DISABILITIES
69 Q:'$O(^DPT(DFN,.372,0))
70 N ACKRD,RC,X,X1
71 D ENS^%ZISS
72 ;---
73 S RC=$$PAGE(5) Q:RC<0 W:'RC !!
74 W IOUON,"Rated Disabilities",IOUOFF,!
75 ;---
76 S ACKRD=0
77 F S ACKRD=$O(^DPT(DFN,.372,ACKRD)) Q:'ACKRD D Q:RC<0
78 . S RC=$$PAGE(2) Q:RC<0
79 . W:RC IOUON,"Rated Disabilities (cont'd)",IOUOFF,!
80 . S X=^DPT(DFN,.372,ACKRD,0),X1=$P(^DIC(31,+X,0),U)
81 . W !,X1_" ("_$P(X,U,2)_"%)" I $P(X,U,3) W " (SC)"
82 Q
83 ;
84DIAGHIST ;
85 Q:$D(ACKICD)<10
86 N ACKI,RC
87 D ENS^%ZISS
88 ;---
89 S RC=$$PAGE(7) Q:RC<0 W:'RC !!
90 W IOUON,"Patient Diagnostic History",IOUOFF
91 W !,$S($P(VADM(5),U)="F":"Ms. ",1:"Mr. "),$P(VADM(1),",")," has been seen for the following:",!
92 D DIHEAD
93 ;---
94 S ACKI=""
95 F S ACKI=$O(ACKICD(ACKI)) Q:ACKI="" D Q:RC<0
96 . S RC=$$PAGE(2) Q:RC<0
97 . I RC D D DIHEAD
98 . . W IOUON,"Patient Diagnostic History (cont'd)"," (",ACK(1),")",IOUOFF,!
99 . W !,$P(ACKICD(ACKI),U),?15,$P(ACKICD(ACKI),U,3)
100 . W ?60,$$NUMDT^ACKQUTL($P(ACKICD(ACKI),U,4))
101 Q
102 ;
103 ;
104CLASDIS ; Display Patient Servive Classifications
105 N RC
106 I '$D(ACKQSER),'$D(ACKQORG),'$D(ACKQIR),'$D(ACKQECON) Q
107 S RC=$$PAGE(5) Q:RC<0 W:'RC !!
108 D ENS^%ZISS
109 W IOUON,"Service Classifications",IOUOFF,!
110 W:$D(ACKQSER) " SERVICE-CONNECTED " W:$D(ACKQORG) " AGENT-ORANGE " W:$D(ACKQIR) " RADIATION " W:$D(ACKQECON) " ENVIRONMENTAL-CONTAMINANTS"
111 W !
112 Q
113 ;
114 ;
115DIHEAD W !,"DIAGNOSIS",?60,"DATE ENTERED",!,$$REPEAT^XLFSTR("-",IOM-1)
116 Q
117 ;
118 ;
119ICDSORT S ACKI=0 F S ACKI=$O(^ACK(509850.2,DFN,1,ACKI)) Q:'ACKI D
120 . S ACKDC=^ACK(509850.2,DFN,1,ACKI,0),ACKDD=$P(ACKDC,U,2)
121 . D GETS^DIQ(80,+ACKDC_",",".01;2;3","E","ACKTGT","ACKMSG")
122 . S ACKDN=ACKTGT(80,+ACKDC_",",.01,"E")
123 . S ACKICD(ACKDN)=ACKDN_U_ACKTGT(80,+ACKDC_",",2,"E")_U_ACKTGT(80,+ACKDC_",",3,"E")_U_ACKDD
124 K ACKTGT,ACKMSG
125 Q
126 ;
127UPDATE ; Update patient's diagnostic history in 509850.2.
128 ; ACKDFN is defined upon entry to this module.
129 D WAIT^DICD W !
130 D PROBLIST^ACKQUTL3(ACKDFN,1)
131 Q
132 ;
133 ;***** CHECKS IS NEW PAGE SHOULD BE STARTED
134 ;
135 ; [RESERVE] Number of additional reserved lines (0, by default).
136 ; If the current page does not have so many lines
137 ; available, a new page will be started.
138 ;
139 ; [FORCE] Force the prompt
140 ;
141 ; Return values:
142 ;
143 ; -2 Timeout
144 ; -1 User canceled the output ('^' was entered)
145 ; 0 Ok
146 ; 1 New page
147 ;
148PAGE(RESERVE,FORCE) ;
149 N RC
150 I ($Y'<($G(IOSL,24)-$G(RESERVE,1)))!$G(FORCE) D S $Y=0
151 . I $E(IOST,1,2)'="C-" W @IOF Q
152 . N DA,DIR,DIROUT,DTOUT,DUOUT,I,X,Y
153 . S DIR(0)="E"
154 . D ^DIR
155 . S RC=$S($D(DUOUT):-1,$D(DTOUT):-2,1:1)
156 . W:RC>0 @IOF
157 Q +$G(RC)
Note: See TracBrowser for help on using the repository browser.