source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHASM4.m@ 623

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1FHASM4 ; HISC/REL/JH - Laboratory/Drug Data ;4/3/01 14:12
2 ;;5.5;DIETETICS;**4,8**;Jan 28, 2005;Build 28
3 S PX=3 D LAB G ^FHASM5
4LAB ; Collect lab results
5 K LRTST,^TMP($J,"LRTST") Q:'DFN
6 S LRDFN=$P($G(^DPT(DFN,"LR")),"^",1) G:'LRDFN LKIL
7 W:PX=3 !!,"Collecting laboratory data ... " D GET
8 S X2=-$S($D(^FH(119.9,1,3)):$P(^(3),"^",2),1:90)
9 S %DT="X",X="T" D ^%DT S DT=+Y,X1=DT D C^%DTC S A1=9999999-X
10 F K=0:0 S K=$O(^LR(LRDFN,"CH",K)) Q:K<1!(K>A1) F L=0:0 S L=$O(^LR(LRDFN,"CH",K,L)) Q:L'>0 I $D(LRTST(L)) S X=^(L) D STR
11 S %=100 F L=0:0 S L=$O(LRTST(L)) Q:L'>0 F SP=0:0 S SP=$O(LRTST(L,SP)) Q:SP'>0 D
12 .I $P(LRTST(L,SP),"^",6)="" K LRTST(L,SP) Q
13 .S %=%+1,^TMP($J,"LRTST",$S($P(LRTST(L,SP),"^",8)'="":$P(LRTST(L,SP),"^",8),1:%))=LRTST(L,SP) Q
14 K LRTST F L=0:0 S L=$O(^TMP($J,"LRTST",L)) Q:L<1 S LRTST(L)=^(L)
15LKIL K %,%H,%I,%T,%DT,A1,FLG,GRP,HI,K,L,LO,LRCW,LRDFN,P60,PC,SP,THER,TNAM,TST,X,X0,X1,X2,Y Q
16STR ;
17 S SP=$P($G(^LR(LRDFN,"CH",K,0)),"^",5) Q:'SP
18 I '$D(LRTST(L,SP)) Q
19 I $P(LRTST(L,SP),"^",6)'="" Q
20 S FHLR=$$TSTRES^LRRPU(LRDFN,"CH",K,L),FHLO=$P(FHLR,U,3),FHI=$P(FHLR,U,4)
21 S $P(LRTST(L,SP),U,5)=$J(FHLO,4)_$S($L(FHI):" - "_$J(FHI,4),1:"")
22 S P60=$P(LRTST(L,SP),"^",2),SP=$P(LRTST(L,SP),"^",3),GRP=$P(LRTST(L,SP),"^",8)
23 S FLG=$P(X,"^",2),X=$P(X,"^",1) Q:X="" S PC=$P($G(^LAB(60,P60,.1)),"^",3)
24 S LRCW=8 I PC="" S X=$J(X,LRCW)
25 E S @("X="_PC)
26 S:FLG'="" X=X_" "_FLG
27 S $P(LRTST(L,SP),"^",6,7)=X_"^"_(9999999-K)
28 I GRP F %=0:0 S %=$O(LRTST(%)) Q:%="" F P60=0:0 S P60=$O(LRTST(%,P60)) Q:P60="" I $P(LRTST(%,P60),"^",8)=GRP,'(%=L&(P60=SP)) D
29 .I $P(LRTST(L,SP),"^",7)>$P(LRTST(%,P60),"^",7) K LRTST(%,P60) Q
30 .K LRTST(L,SP) Q
31 Q
32GET ; Get Lab Tests of interest from Site Parameter file
33 F K=0:0 S K=$O(^FH(119.9,1,"L",K)) Q:K'>0 S X=^(K,0) I 'PX!($P(X,"^",PX)="Y") D G1
34 Q
35G1 S P60=+$P(X,"^",1),SP=$P(X,"^",2),GRP=$P(X,"^",5) Q:'SP S X0=$G(^LAB(60,P60,0)) Q:X0=""
36 S X1=$G(^LAB(60,P60,.1)),TST=$P($P(X0,"^",5),";",2) Q:'TST
37 S TNAM=$P(X0,"^",1) I $L(TNAM)>20 S TNAM=$P(X1,"^",1)
38 S X=$G(^LAB(60,P60,1,SP,0)) Q:'$L(X) S THER=$S($L($P(X,U,11,12))>1:1,1:0) S LO=$S(THER:$P(X,U,11),1:$P(X,U,2)),HI=$S(THER:$P(X,U,12),1:$P(X,U,3))
39 S LRTST(TST,SP)=TNAM_"^"_P60_"^"_SP_"^"_$P(X,"^",7)_"^"_$J(LO,4)_$S($L(HI):" - "_$J(HI,4),1:"")_"^^^"_GRP Q
40 S @("LO="_$S($L(LO):LO,1:"""""")),@("HI="_$S($L(HI):HI,1:""""""))
41DRUG ; Collect requested drugs 0=Outpatient 1=Inpatient
42 K ^TMP($J,"FHCLASS"),^TMP($J,"FHPSORD"),^TMP($J,"FHPSO"),^TMP($J,"FHDRUG"),^TMP($J,"FHPSS")
43 K PC,PSD,PSCNS,PSCA,PDC,FHPH1,PCLS S PORD=99
44 F K=0:0 S K=$O(^FH(119.9,1,"P",K)) Q:K'>0 D
45 .S FHPH1=^(K,0),(X,PSNIEN)=$P(FHPH1,U,1)
46 .S FHPPA=$P(FHPH1,U,3)
47 .S FHPPNS=$P(FHPH1,U,4)
48 .S FHPPOR=$P(FHPH1,U,5)
49 .S FHPAL=$P(FHPH1,U,6)
50 .S:FHPPA="Y" PCA(X)=K
51 .S:FHPPNS="Y" PCNS(X)=K
52 .S:FHPAL="Y" PCAL(X)=K
53 .I FHPPOR S PCORD(X)=FHPPOR
54 .E S PCORD(X)=PORD
55 .D IEN^PSN50P65(PSNIEN,,"FHCLASS") S CLS=$E(^TMP($J,"FHCLASS",PSNIEN,.01),1,3)
56 .I CLS'="" S:$E(CLS,3)="0" CLS=$E(CLS,1,2) S PC(CLS)=""
57 G:'$D(PC) PKIL D NOW^%DTC S STRT=(%\1)-1 I 'PX D OUTP G PKIL
58 D PSS432^PSS55(DFN,,"FHPSORD") F PSORD=0:0 S PSORD=$O(^TMP($J,"FHPSORD","B",PSORD)) Q:'PSORD D D1
59PKIL K %,%H,%I,CLS,DRG,K,PC,PSORD,STRT,X,FHPH1 Q
60OUTP ;
61 D PROF^PSO52API(DFN,"FHPSO",STRT)
62 F JX=0:0 S JX=$O(^TMP($J,"FHPSO",DFN,JX)) Q:JX'>0 D
63 . S X=JX D EN^PSOORDER(DFN,X)
64 . S CLS=$P($P($G(^TMP("PSOR",$J,JX,0)),"^",4),";",1) I CLS'="A",CLS'="H",CLS'="S" Q
65 . S DRG=$P($P($G(^TMP("PSOR",$J,JX,"DRUG",0)),U),";") D:DRG D2
66 . Q
67 Q
68D1 D PSS431^PSS55(DFN,PSORD,,,"FHDRUG")
69 S DRG=$P($G(^TMP($J,"FHDRUG",PSORD,"DDRUG",1,.01)),"^",1)
70 ;
71D2 D DATA^PSS50(DRG,,,,,"FHPSS") I $P(^TMP($J,"FHPSS",0),"^",1)=-1 Q
72 S CLS=^TMP($J,"FHPSS",DRG,2) Q:CLS="" I '$D(PC($E(CLS,1,2))),'$D(PC($E(CLS,1,3))) Q
73 S PSD(DRG)=^TMP($J,"FHPSS",DRG,.01)
74 S PSCL605=$P($G(^TMP($J,"FHPSS",DRG,25)),U,1)
75 I $D(PCAL(PSCL605)),$D(PCORD(PSCL605)) S PCLS(PSD(DRG))=PSCL605
76 I $D(PCA(PSCL605)),$D(PCORD(PSCL605)) S PSCA(PCORD(PSCL605),PSD(DRG))=""
77 I $D(PCNS(PSCL605)),$D(PCORD(PSCL605)) S PSCNS(PCORD(PSCL605),PSD(DRG))=""
78 Q
Note: See TracBrowser for help on using the repository browser.