source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRVLAB.m@ 1608

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1IMRVLAB ;HCIOFO/FAI-Viral Load and CD4 Test Results List ;11/13/01 06:54
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;**5,16**;Feb 09, 1998
3 ;[IMR VIRAL TESTS LIST] - Viral Tests List
4BEGIN I '$D(^XUSEC("IMRMGR",DUZ)) S IMRLOC="IMRVLAB" D ACESSERR^IMRERR,H^XUS K IMRLOC
5 W !,?10,"####################################################"
6 W !,?10,"#",?20,"Local Viral Test and CD4 List",?61,"#"
7 W !,?10,"####################################################"
8 K IMRVALS
9ASK D ^IMRDATE
10 S IMRPG=0 K DIR S DIR(0)="S^V:Viral Test;C:CD4;B:Both",DIR("A")="Select Type of Test(s) Results Requested" D ^DIR S TTYPE=Y K DIR
11 I $D(DIRUT) D KILL Q
12DELM S DELIM="N" R !!,"Do you want the list in delimited format (Y/N)? N// ",X:DTIME S:X="" X="N" I "Yy"[$E(X) S DELIM="Y"
13 I "YyNn"'[$E(X) W $C(7)," ??",!!,"Enter YES or NO" G DELM
14DEV D IMRDEV^IMREDIT
15 G:POP KILL
16 I '$D(IO("Q")) W @IOF D SEARCH Q
17 I $D(IO("Q")) D G KILL
18 .S ZTRTN="DQ^IMRVLAB",ZTDESC="Local Viral Load and CD4 Lists"
19 .S ZTSAVE("*")="",ZTIO=ION_";"_IOM_";"_IOSL
20 .D ^%ZTLOAD K ZTRTN,ZTDESC,ZTSAVE,ZTSK
21 .Q
22 Q
23DQ D TYPE,HEAD,SORT,KILL
24 Q
25SEARCH D TYPE,HEAD,SORT,KILL
26 Q
27 ; *** TAKE QUIT OUT ABOVE
28TYPE ; Entry with IMRDFN defined and pointers for local lab test name & NLT
29 ; FIND TYPE OF TEST EX:VIRAL LOAD
30 D ^IMRSDSP
31 K ^TMP($J)
32ICRPT F ICR=0:0 S ICR=$O(^IMR(158,ICR)) Q:ICR'>0 S X=+^(ICR,0),IMRCAT=$P(^(0),U,42) D ^IMRXOR S (DFN,IMRDFN)=X I $D(^DPT(DFN,0)) D SETLR
33 Q
34SETLR S IMRTSTLR=$P($G(^DPT(DFN,"LR")),U,1),PNAM=$P($G(^DPT(DFN,0)),U,1),SSN=$P($G(^DPT(DFN,0)),U,9)
35 D DATA
36 Q
37DATA K IMRCD
38 Q:$G(IMRTSTLR)=""
39 S (IMRTSTI,IMRTSTII)="",ILR=IMRTSTLR
40CHEMS S LDT="" F S LDT=$O(^LR(ILR,"CH",LDT)) Q:LDT="" D LINK
41 Q
42LINK S DNAM="" F S DNAM=$O(IMRVALS(DNAM)),LDR="" Q:DNAM="" D
43 . F S LDR=$O(IMRVALS(DNAM,LDR)) Q:LDR="" S GRP=$P(IMRVALS(DNAM,LDR),U,1),TYP=$P(IMRVALS(DNAM,LDR),U,2),LNM=$P(IMRVALS(DNAM,LDR),U,3) D LVAL
44 Q
45LVAL S LRES=$P($G(^LR(ILR,"CH",LDT,DNAM)),U,1),DTRC=$P($G(^LR(ILR,"CH",LDT,0)),U,1),Y=DTRC D DD^%DT S DTAA=Y D PLBS
46 Q
47PLBS Q:(DTRC>IMRHNEND)!(DTRC<IMRHNBEG)
48 Q:LRES=""
49 Q:(LRES["CANC")!(LRES["canc")
50 Q:(LRES["COMM")!(LRES["comm")
51 Q:(DTRC["CANC")!(DTRC["canc")
52 S OYR=$E(DTRC,1,3),ODYR=OYR+1700,ODYR=$E(ODYR,3,4),ODAT=$E(DTRC,4,5)_"/"_$E(DTRC,6,7)_"/"_ODYR
53 S DTAA=$E(DTAA,1,18),LDO=$E(LDT,1,7)
54 S ^TMP($J,PNAM,SSN,LDO,TYP,LRES,DNAM)=LNM_U_GRP_U_LDR_U_DTRC_U_ODAT
55 Q
56SORT I '$D(^TMP($J)) W !,"**NO DATA FOUND**" Q
57 S TY=""
58SEC S (P,D)=""
59 F S P=$O(^TMP($J,P)) Q:P="" F S D=$O(^TMP($J,P,D)),I="" Q:D="" F I=0:0 S I=$O(^TMP($J,P,D,I)),T="" Q:I="" F S T=$O(^TMP($J,P,D,I,T)),G="" Q:T="" F S G=$O(^TMP($J,P,D,I,T,G)),H="" Q:G="" F S H=$O(^TMP($J,P,D,I,T,G,H)) Q:H="" D C
60 Q
61C S RC=^TMP($J,P,D,I,T,G,H),LN=$P(RC,U,1),IMDATE=$P(RC,U,5)
62 W:DELIM="Y" !,$E(P,1,15)_"^"_$E(D,6,9)_"^"_$E(T,1,14)_"^"_IMDATE_"^"_$E(LN,1,15)_"^"_G
63 W:DELIM'="Y" !,$E(P,1,15),?17,$E(D,6,9),?23,$E(T,1,14),?39,IMDATE,?50,$E(LN,1,15),?67,$E(G,1,14)
64 S TY=T
65 Q
66KILL D ^%ZISC
67 K ^TMP($J),%,%DT,%I,B,BCDH,BCDL,BRES,BVLH,BVLL,C,CDHN,CDLN,D,DELIM,DNAM,DTAA,DTRC,G,GROUP,GRP,GRPNM,H,ICR,IFN,ILR,IMDATE,DIC,DTOUT,DUOUT,IMRLRC,IMRC,IMRC1,IMRFLG,IMRHNBEG,IMRHNEND,IMRJ,IMRNAM,IMRSTN,IMRSD,IMRED,IMRX
68 K IMRD,IMRAD,IMRDD,IMRDFN,IMRI,IMRLRFN,IMRHNEND,IMRHQUIT,IMRHRANG,IMRHTART,IMRSTN,IMRTEST,IMRDATE,IMRDOT
69 K IMRVALS,IMRUT,I,J,K,M,N,POP,X,X1,Y,DFN,K1,T,IMRV,VAERR,IMRY,IMRZ,DISYS,IMRDTE,IMRPG,IMRCD,IMRTSTI,IMRSSN,IMRTOT,IMRNODE,IMRCAT,IMRDFN,IMRDTNM,IMRFLG,IMRH1HED,IMRH2HED,IMRHENGD,IMRHNBEG
70 K IMRTSTII,IMRTSTLR,L,LBNM,LDO,LDR,LDT,LN,LNM,LRES,NODE,ODAT,ODYR,OYR,P,PNAM,RC,RNG,SELE,SSN,TE,TTYPE,TY,TYP,TYPE,VLH,VLL
71 Q
72EOP ; Check End of Page
73 S IMRUT=0
74 Q:$D(IO("S"))
75 I $E(IOST,1,2)="C-" W ! S DIR(0)="E" D ^DIR K DIR I 'Y S IMRUT=1 Q
76 Q
77HEAD ; Heading of the Specific Lab Report
78 Q:$G(DELIM)="Y"
79 W:'($E(IOST,1,2)'="C-"&'IMRPG) @IOF S IMRPG=IMRPG+1
80 W:IOST'["C-" !!!
81 W !,?23,"CD4/Viral Test Lists",!,?15,IMRHRANG,?65,"Page ",IMRPG,!,?65,IMRHENGD,!!
82 W !,"Name",?17,"SSN",?25,"Type",?41,"Date",?52,"Test",?67,"Result"
83 W !,"----",?17,"---",?25,"----",?41,"----",?52,"----",?67,"------"
84 Q
Note: See TracBrowser for help on using the repository browser.