source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRLIST.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: 6.6 KB
Line 
1IMRLIST ;ISC-SF/JLI HCIOFO/FT-LIST PATIENTS IN THE IMR FILE ; 7/24/02 8:14am
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;**5,18**;Feb 09, 1998
3ENTRY ;[IMR PATIENT LIST] - Local Registry List - ICR Patients
4 W !,?10,"####################################################"
5 W !,?10,"#",?20,"Local Registry List - ICR Patients",?61,"#"
6 W !,?10,"####################################################"
7 D KILL,^IMRDATE Q:$G(IMRHQUIT)
8 S IMRPAT=1,IMRSCT=1,REIM=1,IMREXC="B"
9 K DIR S DIR(0)="S^A:alive;D:deceased;B:both"
10 S DIR("A")="Select Type of Patients"
11 S DIR("?")="^D HELP^IMRLIST"
12 D ^DIR K DIR I $D(DIRUT) D KILL Q
13 S IMREXC=Y
14NEWP R !!,"List New Patients added to the registry during this time (Y/N)? N// ",X:DTIME G:'$T!(X[U) KILL S:X="" X="N" I "Yy"[$E(X) S IMRPAT=2
15 I "YyNn"'[$E(X) W $C(7)," ??",!!,"Enter YES or NO" G NEWP
16 I $D(DIRUT) D KILL Q
17 ;
18CAT R !!,"Do you want the list sorted by Category (Y/N)? N// ",X:DTIME G:'$T!(X[U) KILL S:X="" X="N" I "Yy"[$E(X) S IMRSCT=2
19 I "YyNn"'[$E(X) W $C(7)," ??",!!,"Enter YES or NO" G CAT
20 ; IF LISTING BY CATEGORY IS NO GIVE THE FOLLOWING PROMPT
21REIM I IMRSCT=2 G DEV
22 R !!,"Do you want the list sorted by Reimbursement Level (Y/N)? N// ",X:DTIME G:'$T!(X[U) KILL S:X="" X="N" I "Yy"[$E(X) S REIM=2
23 I "YyNn"'[$E(X) W $C(7)," ??",!!,"Enter YES or NO" G REIM
24 ;
25DEV S %ZIS="MPQ" D IMRDEV^IMREDIT
26 G:POP KILL
27 I $D(IO("Q")) D G KILL
28 .S ZTRTN="DQ^IMRLIST",ZTDESC="List Immunology Patients"
29 .S ZTSAVE("*")="",ZTIO=ION_";"_IOM_";"_IOSL
30 .D ^%ZTLOAD K ZTRTN,ZTDESC,ZTSAVE,ZTSK
31 .Q
32DQ ;
33 U IO K ^TMP($J),IMRLR,IMROUT,IMRPTF,IMRRX,IMRRXN,IMRSCH,IMRST,IMRSUF S IMRPG=0
34 D GETNOW^IMRACESS
35 S IMRHED="Patients Seen During "_$G(IMRHRANG)
36 S IMRHED(1)="FOR "_$S(IMREXC="A":"LIVING ",IMREXC="B":"ALIVE & DECEASED ",IMREXC="D":"DECEASED ",1:"")_"PATIENTS IN THE FILE"
37 F IMRI=0:0 S IMRI=$O(^IMR(158,IMRI)) Q:IMRI'>0 S X=+^(IMRI,0),IMRCAT=$P(^(0),U,42) D ^IMRXOR S (DFN,IMRDFN)=X I $D(^DPT(DFN,0)) D ADD
38 D HEDR S I="",(K,N)=0,IMRUT=0
39 D:(IMRSCT=1)&(REIM=1) PSRP
40 D:(REIM=2)&(IMRSCT=1) PRBR
41 D:(IMRSCT=2)&(REIM=1) PCTR
42 S:$D(ZTQUEUED) ZTREQ="@"
43 D:IOST["C-" PRTC
44KILL D ^%ZISC
45 K ^TMP($J),DFN,DRUG,FDT,FIP,IEN,IMNR,IMRI,IMRTYP,IMRUT,I,J,K,N,X,Y,POP,IMRFLG,IMRSTN,IMRCAT,VADM,VA,VAERR,VAEL,D,DISYS,IMREXC,IMRPG,IMRHED,IMRSD
46 K IMRED,IMRPER,IMRAD,IMRCHK,IMRDD,IMRDFN,IMRDISP,IMRDOD,IMRDSP,IMRDTE,IMREC,IMRFB,IMRINP,IMRJ,IMRLAB
47 K IMRLR,IMROUT,IMRPTF,IMRRX,IMRRXN,IMRSCH,IMRBL,IMRHQUIT,IMRHRANG,IMRHTART,IMRN,IMRPAT,IMRRI,IMRSCT,LCL,LCLAB,LG,LGROUP,LLOC,LNL,LNLT,LOCNM,LV3,IMRH1HED,IMRH2HED,IMRHENGD,IMRHNBEG,IMRHNEND,IMRST,IMRSUF
48 Q
49HELP ;
50 ;;Patients who have no utilization in the provided date range or
51 ;;whose date of death is before the start date will NOT be included
52 ;;in the report of any type.
53 ;;
54 ;;A - Alive patients
55 ;;Only patients who were alive during the whole time frame will be
56 ;;included in the report. If the date of death is between start and
57 ;;end dates, the patient will be skipped.
58 ;;
59 ;;D - Deceased patients
60 ;;Only patients who died during the provided time frame will be
61 ;;included in the report. If the patient is alive or the date of
62 ;;death is after the end date, the patient will be skipped.
63 ;;
64 ;;B - Both alive and deceased
65 ;;All patients (except those mentioned in the first paragraph) will
66 ;;be included in the report.
67 ;
68 N DIR,I,L,TMP
69 S L=IOSL-10 S:L<0 L=999
70 F I=1:1 S TMP=$T(HELP+I) Q:TMP'[";;" D
71 . I '(I#L) W ! D D ^DIR W !
72 . . S DIR(0)="FAO",DIR("A")="Enter RETURN to continue: "
73 . W !,$P(TMP,";;",2)
74 Q
75PSRP ;standard format
76 I '$D(^TMP($J)) W !!?5,"***NO PATIENTS FOUND IN DATE RANGE***"
77 F Q:IMRUT S I=$O(^TMP($J,I)) Q:I="" F J=0:0 S J=$O(^TMP($J,I,J)) Q:J'>0 D:($Y+3>IOSL) PRTC Q:IMRUT D:($Y+3>IOSL) HEDR S K=K+1,N=N+1 W:'(K#5) ! W !,$J(N,5),?6,$P(^(J),U),?36,$P(^(J),U,2),?47,$P(^(J),U,3),?53,$P(^(J),U,5),?65,$P(^(J),U,4)
78 Q
79PRBR ;by arv use
80 I '$D(^TMP($J)) W !!?5,"***NO PATIENTS FOUND IN THIS DATE RANGE***"
81 S TY="" F S TY=$O(^TMP($J,TY)),MC="" Q:TY="" F S MC=$O(^TMP($J,TY,MC)),RM="" Q:MC="" F S RM=$O(^TMP($J,TY,MC,RM)),PD="" Q:RM="" F S PD=$O(^TMP($J,TY,MC,RM,PD)) Q:PD="" D:($Y+3>IOSL) HEDR S K=K+1,N=N+1 W:'(K#5) ! D PR2
82 Q
83PR2 S TYX=TY W:TY'=TYX !,"*** "_TY_" ***"
84 W !,$J(N,5),?7,MC,?14,RM,?39,$P($G(^TMP($J,TY,MC,RM,PD)),U,2),?51,$P($G(^TMP($J,TY,MC,RM,PD)),U,3),?57,$P($G(^TMP($J,TY,MC,RM,PD)),U,4)
85 Q
86PCTR ;by category
87 I '$D(^TMP($J)) W !!?5,"***NO PATIENTS FOUND IN THIS DATE RANGE***"
88 S MRC="" F S MRC=$O(^TMP($J,MRC)),RNM="" Q:MRC="" F S RNM=$O(^TMP($J,MRC,RNM)),PID="" Q:RNM="" F S PID=$O(^TMP($J,MRC,RNM,PID)) Q:PID="" D:($Y+3>IOSL) PRTC Q:IMRUT D:($Y+3>IOSL) HEDR S K=K+1,N=N+1 W:'(K#5) ! D PC2
89 Q
90PC2 W !,$J(N,5),?7,MRC,?14,RNM,?39,$P($G(^TMP($J,MRC,RNM,PID)),U,2),?61,$P($G(^TMP($J,MRC,RNM,PID)),U,4),?71,$P($G(^TMP($J,MRC,RNM,PID)),U,3)
91 Q
92ADD ;
93 N EXIT
94 D 2^VADPT
95 D PERCHK^IMRLCAT1 S DFN=IMRDFN Q:'IMRCHK ;if date range check when patient was seen. quit if not seen in date range.
96 Q:$G(IMRHNBEG)="" Q:$G(IMRHNEND)=""
97 S IMRDOD=$P($G(^IMR(158,IMRI,5)),U,19) ;get IMR DATE OF DEATH
98 S IMRDOD=$S(+VADM(6)>0:+VADM(6),IMRDOD>0:IMRDOD,1:"")
99 S EXIT=1
100 I IMRDOD>0 D
101 . ;--- Quit if date of death is before start date
102 . Q:IMRDOD<IMRHNBEG
103 . ;--- Quit if deceased selected and date of death after end date
104 . I IMREXC="D" Q:IMRDOD>IMRHNEND
105 . ;--- Quit if alive selected and patient is dead
106 . I IMREXC="A" Q:IMRDOD'>IMRHNEND
107 . ;--- Indicate where DOD came from; MAS or ICR
108 . S IMRDOD=$$FMTE^XLFDT(IMRDOD,"2DF")_$S(+VADM(6)>0:"",1:" (ICR)")
109 . K EXIT
110 E K:IMREXC'="D" EXIT
111 Q:$G(EXIT)
112 D ^IMRARVRL S:IMRCAT=4 IMRBL="AIDS"
113 D STAND,ARVUSE,BYCAT
114 K IMRLR,IMROUT,IMRPTF,IMRRX,IMRRXN,IMRSCH,IMRST,IMRSUF
115 Q
116STAND Q:IMRSCT'=1
117 Q:REIM'=1
118 S ^TMP($J,(VADM(1)),DFN)=VADM(1)_U_$P(VADM(2),U)_U_IMRCAT_U_IMRDOD_U_IMRBL
119 Q
120ARVUSE Q:REIM'=2
121 Q:IMRSCT'=1
122 S:IMRBL="ARV" ^TMP($J,"ARV",IMRBL,(VADM(1)),DFN)=VADM(1)_U_$P(VADM(2),U)_U_IMRCAT_U_IMRDOD
123 S:IMRBL="NOARV" ^TMP($J,"NOARV",IMRBL,(VADM(1)),DFN)=VADM(1)_U_$P(VADM(2),U)_U_IMRCAT_U_IMRDOD
124 S:IMRBL="AIDS" ^TMP($J,"AIDS",IMRBL,(VADM(1)),DFN)=VADM(1)_U_$P(VADM(2),U)_U_IMRCAT_U_IMRDOD
125 Q
126BYCAT Q:IMRSCT'=2
127 Q:REIM'=1
128 S ^TMP($J,IMRCAT,(VADM(1)),DFN)=VADM(1)_U_$P(VADM(2),U)_U_IMRDOD_U_IMRBL
129 Q
130 ;
131PRTC ; press return to continue
132 S K=0 Q:IMRUT!($D(IO("S")))
133 I IOST["C-" K DIR W ! S DIR(0)="E" D ^DIR K DIR I 'Y S IMRUT=1
134 Q
135HEDR ; report header
136 S IMRPG=IMRPG+1
137 W:$Y>0 @IOF
138 W !?37,"REGISTRY LIST",!?32,IMRDTE,?70,"Page: ",IMRPG
139 I $G(IMRHED)]"" W !,?(IOM-$L(IMRHED)\2),IMRHED
140 W !,?(IOM-$L(IMRHED(1))\2),IMRHED(1)
141 W:(IMRSCT=1)&(REIM=1) !!,?7,"NAME",?36,"SSN",?47,"CAT",?53,"REIM LEV",?65,"DECEASED",!
142 W:(REIM=2)&(IMRSCT=1) !!,?7,"*REIMB",!,?7,"LEVEL",?16,"NAME",?41,"SSN",?50,"CAT",?60,"DECEASED",!
143 W:(IMRSCT=2)&(REIM=1) !!,?7,"CAT",?16,"NAME",?41,"SSN",?61,"REIM LEV",?71,"DECEASED",!
144 Q
Note: See TracBrowser for help on using the repository browser.