source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRPINQ.m@ 1800

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

initial load of WorldVistAEHR
File size: 5.2 KB
RevLine 
[613]1IMRPINQ ;HCIOFO/FT/FAI-Patient Inquiry ;11/13/01 11:05
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;**5,16**;Feb 09, 1998
3 ; check security
4 S CT=1
5 I '$D(^XUSEC("IMRA",DUZ)) S IMRLOC="IMRPINQ" D ACESSERR^IMRERR,H^XUS K IMRLOC
6 D:'$D(IMRSTN) IMROPN^IMRXOR
7 W !,?19,"###### LOCAL PATIENT CLINICAL HISTORY ######",!,?3,"Clinical history, including: CD4 count, CD4%, Viral Load and ARV Medication.",!
8BEGIN D ^IMRDATE
9 I $G(IMRHNBEG)="" G KILL Q
10ASK ; Select Patient
11 W ! K DIC S DIC=2,DIC(0)="AEQM" D ^DIC K DIC I Y'>0 D KILL Q
12 S (FLOID,X,DFN)=+Y D ^IMRXOR
13 I '$D(^IMR(158,"B",X)) S Y=-1 G:Y<0 ASK
14 S IMRDA=$O(^IMR(158,"B",X,0)) G:'IMRDA ASK
15 K DIR
16 ; select lab tests
17 W:CT'>2 !,?5,"## You may now select up to three additional laboratory tests ##"
18LABT G:CT>3 DEV W ! K DIC S DIC=60,DIC(0)="AEQM" D ^DIC S LB=+Y K DIC I Y'>0 G DEV
19 S CT=CT+1,IMRLABS(CT)=LB G LABT
20DEV ; select device
21 D IMRDEV^IMREDIT I POP D KILL Q
22 I $D(IO("Q")) D D CLOSE G ASK
23 .S ZTRTN="START^IMRPINQ",ZTDESC="Immunology Local Patient Clinical History",ZTIO=ION_";"_IOM_";"_IOSL
24 .S ZTSAVE("*")=""
25 .D ^%ZTLOAD
26 .K IO("Q"),ZTRTN,ZTDESC,ZTSK,ZTIO,ZTSAVE
27 .Q
28 ;
29START ; start display
30 U IO K ^TMP($J),VADM
31 S IMRTSTLR=$P($G(^DPT(DFN,"LR")),U,1)
32 D DEM^VADPT
33 S IMRNAME=$P(VADM(1),U,1),IMRSSN=$P(VADM(2),U,2),IMRSEX=$P(VADM(5),U,2)
34 S IMRAGE=$P(VADM(4),U,1),IMRDOD=$P(VADM(6),U,2)
35 S (IMROUT,IMRPG)=0
36 K VADM
37 D GETNOW^IMRACESS ;get current date/time
38 D GETS^DIQ(158,IMRDA,"**","E","^TMP($J)") ;patient's file 158 entry
39 D HDR
40 S IMR158=$O(^TMP($J,""))
41 I IMR158="" W !!,"No data for this patient." G HOLD
42DEMO ;
43 W !?9,"*** D E M O G R A P H I C D A T A ***",!
44 F IMRLOOP=1,3.4,3.6,3.3,3.5,4,15.5,15.6,110.01,110.02,15.8,15.7,5.19,112.05,102.08,102.23,16.1,16.2,16.3,16.4,16.5,16.6,104.01,104.02,104.03,104.04,104.05,104.06 G:IMROUT CLOSE D WRITE
45FAC ;
46 I $Y>(IOSL-4) D PRTC G:IMROUT CLOSE D HDR
47 W !!?9,"*** F A C I L I T Y O F D I A G N O S I S ***",!
48 F IMRLOOP=16.7,16.8,16.9,16.11,110.16,112.06,102.1 G:IMROUT CLOSE D WRITE
49PH ;
50 I $Y>(IOSL-4) D PRTC G:IMROUT CLOSE D HDR
51 W !!?9,"*** P A T I E N T H I S T O R Y ***",!
52 F IMRLOOP=120,17.8,17.9,16.19,15.9,16.12,16.13,16.22,16.23,16.24,16.25,110.03,16.26,16.14,16.15,16.16,102.14,16.17,16.18 G:IMROUT CLOSE D WRITE
53TR I $Y>(IOSL-4) D PRTC G:IMROUT CLOSE D HDR
54 W !!?9,"*** L A B O R A T O R Y T E S T R E S U L T S ***",!
55 D ^IMRPLAB
56 I $Y>(IOSL-4) D PRTC G:IMROUT CLOSE D HDR
57 D ^IMRTST
58 I $Y>(IOSL-4) D PRTC G:IMROUT CLOSE D HDR
59 D ^IMROLAB
60ARV I $Y>(IOSL-4) D PRTC G:IMROUT CLOSE D HDR
61 W !!?9,"*** A R V M E D I C A T I O N S***",!
62 D ^IMRARVCH
63CS I $Y>(IOSL-4) D PRTC G:IMROUT CLOSE D HDR
64 W !!?9,"*** C L I N I C A L S T A T U S ***",!
65 F IMRLOOP=110.04,112.07,112.08,110.05 G:IMROUT CLOSE D WRITE
66TSR ;
67 I $Y>(IOSL-4) D PRTC G:IMROUT CLOSE D HDR
68 W !!?5,"*** T R E A T M E N T / S E R V I C E S R E F E R R A L S ***",!
69 F IMRLOOP=110.06,110.07,110.08,110.09,112.11,110.1,110.11,110.12 G:IMROUT CLOSE D WRITE
70 I IMRSEX="FEMALE" F IMRLOOP=110.13,110.14,110.15,112.01,112.02,112.03,112.04 G:IMROUT CLOSE D WRITE
71OTHER ;
72 I $Y>(IOSL-4) D PRTC G:IMROUT CLOSE D HDR
73 W !!?9,"*** O T H E R D A T A ***",!
74 F IMRLOOP=10.01,11.01,12.01 G:IMROUT CLOSE D WRITE
75D ;
76 I $Y>(IOSL-4) D PRTC G:IMROUT CLOSE D HDR
77 W !!?9,"*** D I S E A S E S ***",!
78 K IMRDIS
79 S IMRDD=".01,.14,.02,.15,.03,.16,.04,.17,.05,.18,.06,.19,.07,.2,.08,.21,.09,.22,.1,.23,.11,.24,.12,.25,.13,.26"
80 S IMRIX="7,8.2,7.1,8.3,102.15,8.4,7.2,8.5,7.3,102.16,7.4,8.6,7.5,8.7,7.6,8.8,7.7,102.17,7.8,8.9,7.9,9,8,9.1,8.1,9.2"
81 F IMRLOOP=1:1 S IMRDISN=$P(IMRDD,",",IMRLOOP) Q:IMRDISN="" D
82 .S IMRFLDN=108_IMRDISN
83 .S IMRDATE=$$GET1^DIQ(158,IMRDA,IMRFLDN,"I")
84 .Q:IMRDATE'>0
85 .S IMRFIELD=$P($G(^DD(158,IMRFLDN,0)),U,1)
86 .S IMRDP=$P(IMRIX,",",IMRLOOP)
87 .S IMRDP=$$GET1^DIQ(158,IMRDA,IMRDP,"I")
88 .S IMRDIS(IMRDATE,IMRFIELD)=IMRDP
89 .Q
90 I $D(IMRDIS) S IMRLOOP=0 F S IMRLOOP=$O(IMRDIS(IMRLOOP)) Q:IMRLOOP'>0 S IMRDISN="" F S IMRDISN=$O(IMRDIS(IMRLOOP,IMRDISN)) Q:IMRDISN="" D
91 .I $Y>(IOSL-4) D PRTC Q:IMROUT D HDR
92 .S IMRDP=IMRDIS(IMRLOOP,IMRDISN)
93 .W !,$$FMTE^XLFDT(IMRLOOP,"2D"),?10,IMRDISN,?50,$S(IMRDP="1":"Definitive",IMRDP=2:"Presumptive",1:"NO or NOT APPLICABLE")
94 .Q
95 K IMRDATE,IMRDD,IMRDIS,IMRDISN,IMRDP,IMRFIELD,IMRFLDN,IMRIX
96 S DFN=FLOID D IMMUN^IMRPINQ1 ;list immunizations
97 K ^TMP("PXI",$J),IMRI,IMRLOOP,IMRVAC
98 D KILL
99 S:$D(ZTQUEUED) ZTREQ="@"
100 Q
101HOLD D:'IMROUT PRTC
102CLOSE D ^%ZISC
103 Q
104KILL ; kill variables
105 D ^%ZISC K IMR158,IMRAGE,IMRDA,IMRDATE,IMRDD,IMRDFN,IMRDIS,IMRDISN,IMRDL,IMRDOD,IMRDP,IMRDTE,IMRED,IMRFIELD,IMRFLDN,IMRFLG,IMRHNEND,IMRHNBEG,IMRI,IMRIX
106 K IMRLABS,IMRLOOP,IMRLRC,IMRNAME,IMROUT,IMRPER,IMRPG,IMRSD,IMRSEX,IMRSSN,IMRSTN,IMRVAC,IMRYES
107 K ^TMP($J),^TMP("PXI",$J),C,DISYS,POP,VA("BID"),VA("PID"),VAERR,X,Y
108 Q
109WRITE I $Y>(IOSL-4) D PRTC Q:IMROUT D HDR
110 S IMRFIELD=$P($G(^DD(158,IMRLOOP,0)),U,1)
111 W !,?(35-($L(IMRFIELD)+2)),IMRFIELD_": ",?35,$G(^TMP($J,158,IMRDA_",",IMRLOOP,"E"))
112 Q
113PRTC ;
114 Q:$E(IOST)'="C"
115 Q:$D(IO("S"))
116 K DIR S DIR(0)="E" D ^DIR K DIR S:$D(DIRUT)!(Y=0) IMROUT=1
117 Q
118HDR ; header
119 W:$Y>0 @IOF
120 S IMRPG=IMRPG+1
121 W !?3,"#### P A T I E N T C L I N I C A L H I S T O R Y ####",!!,?40,IMRDTE,?70,"Page: ",IMRPG
122 W !!,?15,$G(IMRHRANG),!!
123 W !,IMRNAME_" ("_IMRSSN_")"_" "_IMRSEX_" Age: ",IMRAGE,!
124 I IMRDOD]"" W "[Patient died on "_IMRDOD_"]",!
125 Q
126WARNING ; old line
127 Q
Note: See TracBrowser for help on using the repository browser.