| 1 | IMRVLAB ;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
|
|---|
| 4 | BEGIN 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
|
|---|
| 9 | ASK 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
|
|---|
| 12 | DELM 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
|
|---|
| 14 | DEV 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
|
|---|
| 23 | DQ D TYPE,HEAD,SORT,KILL
|
|---|
| 24 | Q
|
|---|
| 25 | SEARCH D TYPE,HEAD,SORT,KILL
|
|---|
| 26 | Q
|
|---|
| 27 | ; *** TAKE QUIT OUT ABOVE
|
|---|
| 28 | TYPE ; 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)
|
|---|
| 32 | ICRPT 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
|
|---|
| 34 | SETLR 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
|
|---|
| 37 | DATA K IMRCD
|
|---|
| 38 | Q:$G(IMRTSTLR)=""
|
|---|
| 39 | S (IMRTSTI,IMRTSTII)="",ILR=IMRTSTLR
|
|---|
| 40 | CHEMS S LDT="" F S LDT=$O(^LR(ILR,"CH",LDT)) Q:LDT="" D LINK
|
|---|
| 41 | Q
|
|---|
| 42 | LINK 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
|
|---|
| 45 | LVAL 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
|
|---|
| 47 | PLBS 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
|
|---|
| 56 | SORT I '$D(^TMP($J)) W !,"**NO DATA FOUND**" Q
|
|---|
| 57 | S TY=""
|
|---|
| 58 | SEC 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
|
|---|
| 61 | C 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
|
|---|
| 66 | KILL 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
|
|---|
| 72 | EOP ; 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
|
|---|
| 77 | HEAD ; 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
|
|---|
