IMRPINQ ;HCIOFO/FT/FAI-Patient Inquiry ;11/13/01  11:05
 ;;2.1;IMMUNOLOGY CASE REGISTRY;**5,16**;Feb 09, 1998
 ; check security
 S CT=1
 I '$D(^XUSEC("IMRA",DUZ)) S IMRLOC="IMRPINQ" D ACESSERR^IMRERR,H^XUS K IMRLOC
 D:'$D(IMRSTN) IMROPN^IMRXOR
 W !,?19,"###### LOCAL PATIENT CLINICAL HISTORY ######",!,?3,"Clinical history, including: CD4 count, CD4%, Viral Load and ARV Medication.",!
BEGIN D ^IMRDATE
 I $G(IMRHNBEG)="" G KILL Q
ASK ; Select Patient
 W ! K DIC S DIC=2,DIC(0)="AEQM" D ^DIC K DIC I Y'>0 D KILL Q
 S (FLOID,X,DFN)=+Y D ^IMRXOR
 I '$D(^IMR(158,"B",X)) S Y=-1 G:Y<0 ASK
 S IMRDA=$O(^IMR(158,"B",X,0)) G:'IMRDA ASK
 K DIR
 ; select lab tests
 W:CT'>2 !,?5,"## You may now select up to three additional laboratory tests ##"
LABT 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
 S CT=CT+1,IMRLABS(CT)=LB G LABT
DEV ; select device
 D IMRDEV^IMREDIT I POP D KILL Q
 I $D(IO("Q")) D  D CLOSE G ASK
 .S ZTRTN="START^IMRPINQ",ZTDESC="Immunology Local Patient Clinical History",ZTIO=ION_";"_IOM_";"_IOSL
 .S ZTSAVE("*")=""
 .D ^%ZTLOAD
 .K IO("Q"),ZTRTN,ZTDESC,ZTSK,ZTIO,ZTSAVE
 .Q
 ;
START ; start display
 U IO K ^TMP($J),VADM
 S IMRTSTLR=$P($G(^DPT(DFN,"LR")),U,1)
 D DEM^VADPT
 S IMRNAME=$P(VADM(1),U,1),IMRSSN=$P(VADM(2),U,2),IMRSEX=$P(VADM(5),U,2)
 S IMRAGE=$P(VADM(4),U,1),IMRDOD=$P(VADM(6),U,2)
 S (IMROUT,IMRPG)=0
 K VADM
 D GETNOW^IMRACESS ;get current date/time
 D GETS^DIQ(158,IMRDA,"**","E","^TMP($J)") ;patient's file 158 entry
 D HDR
 S IMR158=$O(^TMP($J,""))
 I IMR158="" W !!,"No data for this patient." G HOLD
DEMO ;
 W !?9,"*** D E M O G R A P H I C  D A T A ***",!
 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
FAC ;
 I $Y>(IOSL-4) D PRTC G:IMROUT CLOSE  D HDR
 W !!?9,"*** F A C I L I T Y  O F  D I A G N O S I S ***",!
 F IMRLOOP=16.7,16.8,16.9,16.11,110.16,112.06,102.1 G:IMROUT CLOSE D WRITE
PH ;
 I $Y>(IOSL-4) D PRTC G:IMROUT CLOSE D HDR
 W !!?9,"*** P A T I E N T  H I S T O R Y ***",!
 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
TR I $Y>(IOSL-4) D PRTC G:IMROUT CLOSE D HDR
 W !!?9,"*** L A B O R A T O R Y  T E S T  R E S U L T S ***",!
 D ^IMRPLAB
 I $Y>(IOSL-4) D PRTC G:IMROUT CLOSE D HDR
 D ^IMRTST
 I $Y>(IOSL-4) D PRTC G:IMROUT CLOSE D HDR
 D ^IMROLAB
ARV I $Y>(IOSL-4) D PRTC G:IMROUT CLOSE D HDR
 W !!?9,"*** A R V  M E D I C A T I O N S***",!
 D ^IMRARVCH
CS I $Y>(IOSL-4) D PRTC G:IMROUT CLOSE D HDR
 W !!?9,"*** C L I N I C A L  S T A T U S ***",!
 F IMRLOOP=110.04,112.07,112.08,110.05 G:IMROUT CLOSE D WRITE
TSR ;
 I $Y>(IOSL-4) D PRTC G:IMROUT CLOSE D HDR
 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 ***",!
 F IMRLOOP=110.06,110.07,110.08,110.09,112.11,110.1,110.11,110.12 G:IMROUT CLOSE D WRITE
 I IMRSEX="FEMALE" F IMRLOOP=110.13,110.14,110.15,112.01,112.02,112.03,112.04 G:IMROUT CLOSE D WRITE
OTHER ;
 I $Y>(IOSL-4) D PRTC G:IMROUT CLOSE D HDR
 W !!?9,"*** O T H E R  D A T A ***",!
 F IMRLOOP=10.01,11.01,12.01 G:IMROUT CLOSE D WRITE
D ;
 I $Y>(IOSL-4) D PRTC G:IMROUT CLOSE D HDR
 W !!?9,"*** D I S E A S E S ***",!
 K IMRDIS
 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"
 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"
 F IMRLOOP=1:1 S IMRDISN=$P(IMRDD,",",IMRLOOP) Q:IMRDISN=""  D
 .S IMRFLDN=108_IMRDISN
 .S IMRDATE=$$GET1^DIQ(158,IMRDA,IMRFLDN,"I")
 .Q:IMRDATE'>0
 .S IMRFIELD=$P($G(^DD(158,IMRFLDN,0)),U,1)
 .S IMRDP=$P(IMRIX,",",IMRLOOP)
 .S IMRDP=$$GET1^DIQ(158,IMRDA,IMRDP,"I")
 .S IMRDIS(IMRDATE,IMRFIELD)=IMRDP
 .Q
 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
 .I $Y>(IOSL-4) D PRTC Q:IMROUT  D HDR
 .S IMRDP=IMRDIS(IMRLOOP,IMRDISN)
 .W !,$$FMTE^XLFDT(IMRLOOP,"2D"),?10,IMRDISN,?50,$S(IMRDP="1":"Definitive",IMRDP=2:"Presumptive",1:"NO or NOT APPLICABLE")
 .Q
 K IMRDATE,IMRDD,IMRDIS,IMRDISN,IMRDP,IMRFIELD,IMRFLDN,IMRIX
 S DFN=FLOID D IMMUN^IMRPINQ1 ;list immunizations
 K ^TMP("PXI",$J),IMRI,IMRLOOP,IMRVAC
 D KILL
 S:$D(ZTQUEUED) ZTREQ="@"
 Q
HOLD D:'IMROUT PRTC
CLOSE D ^%ZISC
 Q
KILL ; kill variables
 D ^%ZISC K IMR158,IMRAGE,IMRDA,IMRDATE,IMRDD,IMRDFN,IMRDIS,IMRDISN,IMRDL,IMRDOD,IMRDP,IMRDTE,IMRED,IMRFIELD,IMRFLDN,IMRFLG,IMRHNEND,IMRHNBEG,IMRI,IMRIX
 K IMRLABS,IMRLOOP,IMRLRC,IMRNAME,IMROUT,IMRPER,IMRPG,IMRSD,IMRSEX,IMRSSN,IMRSTN,IMRVAC,IMRYES
 K ^TMP($J),^TMP("PXI",$J),C,DISYS,POP,VA("BID"),VA("PID"),VAERR,X,Y
 Q
WRITE I $Y>(IOSL-4) D PRTC Q:IMROUT  D HDR
 S IMRFIELD=$P($G(^DD(158,IMRLOOP,0)),U,1)
 W !,?(35-($L(IMRFIELD)+2)),IMRFIELD_": ",?35,$G(^TMP($J,158,IMRDA_",",IMRLOOP,"E"))
 Q
PRTC ;
 Q:$E(IOST)'="C"
 Q:$D(IO("S"))
 K DIR S DIR(0)="E" D ^DIR K DIR S:$D(DIRUT)!(Y=0) IMROUT=1
 Q
HDR ; header
 W:$Y>0 @IOF
 S IMRPG=IMRPG+1
 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
 W !!,?15,$G(IMRHRANG),!!
 W !,IMRNAME_"  ("_IMRSSN_")"_"     "_IMRSEX_"     Age: ",IMRAGE,!
 I IMRDOD]"" W "[Patient died on "_IMRDOD_"]",!
 Q
WARNING ; old line
 Q