source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCLTST4.m@ 1154

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

initial load of WorldVistAEHR

File size: 3.2 KB
RevLine 
[613]1YSCLTST4 ;DALOI/LB/RLM-TRANSMIT RX AND lAB DATA FOR CLOZAPINE ;19 Feb 93
2 ;;5.01;MENTAL HEALTH;**92**;Dec 30, 1994;Build 7
3 ; Reference to ^LAB(60 supported by IA #333
4 ; Reference to ^LR7OR1 supported by IA #2503
5 ;
6CL1 ;(DFN,DAYS) ;
7 K ^TMP($J,"PSO"),RESULTS,YSCLYWBC,YSCLRANC,YSCLXWBC
8 Q:'DFN
9 S:'$G(DAYS) DAYS=90
10 S YSCLFRQ=$O(^YSCL(603.01,"C",DFN,"")) I YSCLFRQ]"" S YSCLFRQ=$P(^YSCL(603.01,YSCLFRQ,0),"^",3)
11 I $G(^YSCL(603.03,1,1))=1 Q "-1^0^0^0^0^0^"_YSCLFRQ
12 S X1=DT,X2="-"_DAYS D C^%DTC S YSCLSD=X
13 S YSCLA=0 F S YSCLA=$O(^YSCL(603.04,1,1,YSCLA)) Q:'YSCLA S YSCLTLS=^YSCL(603.04,1,1,YSCLA,0),YSCLTLS($P(YSCLTLS,"^",2),$P(YSCLTLS,"^",1))=$P(YSCLTLS,"^",3)
14 S YSCLTL="" F S YSCLTL=$O(^YSCL(603.04,1,1,"B",YSCLTL)) Q:'YSCLTL D
15 . D RR^LR7OR1(DFN,,YSCLSD,DT,,YSCLTL,"L")
16 . S YSCLSB1="" F S YSCLSB1=$O(^TMP("LRRR",$J,DFN,YSCLSB1)) Q:YSCLSB1="" D
17 . . S YSCLTDT="" F S YSCLTDT=$O(^TMP("LRRR",$J,DFN,YSCLSB1,YSCLTDT)) Q:YSCLTDT="" I $P(YSCLTDT,".",2)]"" D
18 . . . S YSCLTA="" F S YSCLTA=$O(^TMP("LRRR",$J,DFN,YSCLSB1,YSCLTDT,YSCLTA)) Q:YSCLTA="" I YSCLTA D
19 . . . . S RESULTS1=^TMP("LRRR",$J,DFN,YSCLSB1,YSCLTDT,YSCLTA)
20 . . . . S RESULTS(YSCLTL,YSCLTDT)=$P(RESULTS1,"^",2)
21 ;Find all entries for WBC and sort by inverse date.
22 S YSCLA="" F S YSCLA=$O(YSCLTLS("W",YSCLA)) Q:'YSCLA S YSCLXWBC(YSCLA)="" D
23 . S YSCLA1="" F S YSCLA1=$O(RESULTS(YSCLA,YSCLA1)) Q:'YSCLA1 S YSCLYWBC(YSCLA1)=RESULTS(YSCLA,YSCLA1)*$S(YSCLTLS("W",YSCLA):1000,1:1)
24 S YSCLRWBC=0 F S YSCLRWBC=$O(YSCLYWBC(YSCLRWBC)) Q:YSCLRWBC="" S YSCLRWBC(YSCLRWBC)=YSCLYWBC(YSCLRWBC) D
25 . ;Match all ANC's and WBC's
26 . S YSCLMTCH=0 F YSCLA="A","N","S","C" S YSCLTPT="" F S YSCLTPT=$O(YSCLTLS(YSCLA,YSCLTPT)) Q:'YSCLTPT D
27 . . I $D(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="A",$D(YSCLRWBC(YSCLRWBC)) S ^TMP($J,"PSO",YSCLRWBC)=YSCLRWBC(YSCLRWBC)_"^"_(RESULTS(YSCLTPT,YSCLRWBC)*$S(YSCLTLS(YSCLA,YSCLTPT):1000,1:1)) Q
28 . . I $D(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="N",$D(YSCLRWBC(YSCLRWBC)) S ^TMP($J,"PSO",YSCLRWBC)=YSCLRWBC(YSCLRWBC)_"^"_(YSCLRWBC(YSCLRWBC)*((RESULTS(YSCLTPT,YSCLRWBC)*.01))) Q
29 . . I $D(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="S",$D(YSCLRWBC(YSCLRWBC)) D
30 . . . S (YSCLSG1,YSCLSGS)="" F S YSCLSGS=$O(YSCLTLS("B",YSCLSGS)) D Q:'YSCLSGS
31 . . . . I 'YSCLSG1,'YSCLSGS S YSCLSGS="Z",YSCLSG1=1
32 . . . . I 'YSCLSGS,YSCLSG1 Q
33 . . . . I '$D(RESULTS(YSCLSGS,YSCLRWBC)) S RESULTS(YSCLSGS,YSCLRWBC)=0
34 . . . . S ^TMP($J,"PSO",YSCLRWBC)=YSCLRWBC(YSCLRWBC)_"^"_(YSCLRWBC(YSCLRWBC)*((RESULTS(YSCLTPT,YSCLRWBC)*.01)+(RESULTS(YSCLSGS,YSCLRWBC)*.01))) Q
35 . . I $D(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="C" D
36 . . . S YSCLSGS="" F S YSCLSGS=$O(YSCLTLS("T",YSCLSGS)) D Q:'YSCLSGS
37 . . . . I '$G(YSCLSG1),'YSCLSGS S YSCLSGS="Z",YSCLSG1=1
38 . . . . I 'YSCLSGS,$G(YSCLSG1) Q
39 . . . . I '$D(RESULTS(YSCLSGS,YSCLRWBC)) S RESULTS(YSCLSGS,YSCLRWBC)=0
40 . . . . S ^TMP($J,"PSO",YSCLRWBC)=YSCLRWBC(YSCLRWBC)_"^"_((RESULTS(YSCLTPT,YSCLRWBC)*$S(YSCLTLS(YSCLA,YSCLTPT):1000,1:1))+(RESULTS(YSCLSGS,YSCLRWBC))) Q
41 K FDA,YSCLSGS,Y15,YSCLRWBC,YSCLANC,YSCLYWBC,YSCLFRQ,ZIENS,RESULTS,RESULTS1,YSCLA,YSCLA1,YSCLMTCH,YSCLSB1,YSCLSD
42 K YSCLTA,YSCLTDT,YSCLTL,YSCLTLS,YSCLTPT,YSCLXWBC,YSCLMULT
43 Q
44 ;
45KILL ;
46 K FDA,YSCLSGS,Y15,RESULTS,RESULTS1,YSCLA,YSCLA1,YSCLMTCH,YSCLSB1,YSCLSD,YSCLTA,YSCLMULT
47 K YSCLTDT,YSCLTL,YSCLSG1,YSCLTLS,YSCLTPT,YSCLXWBC
48 ;
49ZEOR ;YSCLTST4
Note: See TracBrowser for help on using the repository browser.