128 lines
7.2 KiB
Mathematica
128 lines
7.2 KiB
Mathematica
|
PSS52P6B ;BIR/LDT - API FOR INFORMATION FROM FILE 52.6 CONT.; 5 Sep 03
|
||
|
|
;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
|
||
|
|
;
|
||
|
|
ELYTES ;
|
||
|
|
S SCR("S")=""
|
||
|
|
I +$G(PSSFL)>0 N ND D SETSCRN^PSS52P6A
|
||
|
|
I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(52.6,"","A","`"_PSSIEN,,SCR("S"),"") D
|
||
|
|
.I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
|
||
|
|
.S ^TMP($J,LIST,0)=1
|
||
|
|
.D GETS^DIQ(52.6,+PSSIEN2,".01;8*","IE","^TMP(""PSS52P6"",$J)") S PSS(1)=0
|
||
|
|
.F S PSS(1)=$O(^TMP("PSS52P6",$J,52.6,PSS(1))) Q:'PSS(1) D
|
||
|
|
..S ^TMP($J,LIST,+PSSIEN2,.01)=^TMP("PSS52P6",$J,52.6,PSS(1),.01,"I")
|
||
|
|
..S ^TMP($J,LIST,"B",^TMP("PSS52P6",$J,52.6,PSS(1),.01,"I"),+PSSIEN2)=""
|
||
|
|
.N CNT S (PSS(1),CNT)=0 F S PSS(1)=$O(^TMP("PSS52P6",$J,52.62,PSS(1))) Q:'PSS(1) D SETLTS^PSS52P6A S CNT=CNT+1
|
||
|
|
.S ^TMP($J,LIST,+PSSIEN,"ELYTES",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
|
||
|
|
I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
|
||
|
|
.I PSSFT["??" D LOOP^PSS52P6A(3) Q
|
||
|
|
.D FIND^DIC(52.6,,"@;.01;2","QP",PSSFT,,"B",SCR("S"),,"")
|
||
|
|
.I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
|
||
|
|
.I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
|
||
|
|
..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K ^TMP("PSS52P6",$J) D GETS^DIQ(52.6,+PSSIEN,"8*","IE","^TMP(""PSS52P6"",$J)") D
|
||
|
|
...S ^TMP($J,LIST,+PSSIEN,.01)=$P(^TMP("DILIST",$J,PSSXX,0),"^",2)
|
||
|
|
...S ^TMP($J,LIST,"B",$P(^TMP("DILIST",$J,PSSXX,0),"^",2),+PSSIEN)=""
|
||
|
|
..N CNT S (PSS(1),CNT)=0 F S PSS(1)=$O(^TMP("PSS52P6",$J,52.62,PSS(1))) Q:'PSS(1) D SETLTS^PSS52P6A S CNT=CNT+1
|
||
|
|
..S ^TMP($J,LIST,+PSSIEN,"ELYTES",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
|
||
|
|
K ^TMP("DILIST",$J),^TMP("PSS52P6",$J)
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
SYNONYM ;
|
||
|
|
S SCR("S")=""
|
||
|
|
I +$G(PSSFL)>0 N ND D SETSCRN^PSS52P6A
|
||
|
|
I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(52.6,"","A","`"_PSSIEN,,SCR("S"),"") D
|
||
|
|
.I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
|
||
|
|
.S ^TMP($J,LIST,0)=1
|
||
|
|
.D GETS^DIQ(52.6,+PSSIEN2,".01;9*","IE","^TMP(""PSS52P6"",$J)") S PSS(1)=0
|
||
|
|
.N CNT S (PSS(1),CNT)=0 F S PSS(1)=$O(^TMP("PSS52P6",$J,52.63,PSS(1))) Q:'PSS(1) D SETSYN^PSS52P6A S CNT=CNT+1
|
||
|
|
.S PSS(2)=0 F S PSS(2)=$O(^TMP("PSS52P6",$J,52.6,PSS(2))) Q:'PSS(2) D
|
||
|
|
..S ^TMP($J,LIST,+PSS(2),.01)=^TMP("PSS52P6",$J,52.6,PSS(2),.01,"I")
|
||
|
|
..S ^TMP($J,LIST,"B",^TMP("PSS52P6",$J,52.6,PSS(2),.01,"I"),+PSS(2))=""
|
||
|
|
.S ^TMP($J,LIST,+PSSIEN,"SYN",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
|
||
|
|
I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
|
||
|
|
.I PSSFT["??" D LOOP^PSS52P6A(4) Q
|
||
|
|
.D FIND^DIC(52.6,,"@;.01;2","QP",PSSFT,,"B",SCR("S"),,"")
|
||
|
|
.I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
|
||
|
|
.I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
|
||
|
|
..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K ^TMP("PSS52P6",$J) D GETS^DIQ(52.6,+PSSIEN,"9*","IE","^TMP(""PSS52P6"",$J)") D
|
||
|
|
...S ^TMP($J,LIST,+PSSIEN,.01)=$P(^TMP("DILIST",$J,PSSXX,0),"^",2)
|
||
|
|
...S ^TMP($J,LIST,"B",$P(^TMP("DILIST",$J,PSSXX,0),"^",2),+PSSIEN)=""
|
||
|
|
..N CNT S (PSS(1),CNT)=0 F S PSS(1)=$O(^TMP("PSS52P6",$J,52.63,PSS(1))) Q:'PSS(1) D SETSYN^PSS52P6A S CNT=CNT+1
|
||
|
|
..S ^TMP($J,LIST,+PSSIEN,"SYN",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
|
||
|
|
K ^TMP("DILIST",$J),^TMP("PSS52P6",$J)
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
DRGINFO ;
|
||
|
|
S SCR("S")=""
|
||
|
|
I +$G(PSSFL)>1 N ND D SETSCRN^PSS52P6A
|
||
|
|
I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(52.6,"","A","`"_PSSIEN,,SCR("S"),"") D
|
||
|
|
.I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
|
||
|
|
.S ^TMP($J,LIST,0)=1
|
||
|
|
.D GETS^DIQ(52.6,+PSSIEN2,".01;10","E","^TMP(""PSS52P6"",$J)")
|
||
|
|
.S PSS(1)=0 F S PSS(1)=$O(^TMP("PSS52P6",$J,52.6,PSS(1))) Q:'PSS(1) D
|
||
|
|
..S ^TMP($J,LIST,+PSS(1),.01)=^TMP("PSS52P6",$J,52.6,PSS(1),.01,"E")
|
||
|
|
..S ^TMP($J,LIST,"B",^TMP("PSS52P6",$J,52.6,PSS(1),.01,"E"),+PSS(1))=""
|
||
|
|
..S PSS(3)=0 F S PSS(3)=$O(^TMP("PSS52P6",$J,52.6,PSS(1),10,PSS(3))) Q:'PSS(3) D SETDRI^PSS52P6A
|
||
|
|
..I '$D(^TMP($J,LIST,+PSS(1),"DRGINF")) S ^TMP($J,LIST,+PSS(1),"DRGINF",0)="-1^NO DATA FOUND"
|
||
|
|
I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
|
||
|
|
.I PSSFT["??" D LOOP^PSS52P6A(5) Q
|
||
|
|
.D FIND^DIC(52.6,,"@;.01","QP",PSSFT,,"B^C^D",SCR("S"),,"")
|
||
|
|
.I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
|
||
|
|
.I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
|
||
|
|
..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K ^TMP("PSS52P6",$J) D GETS^DIQ(52.6,+PSSIEN,".01;10","E","^TMP(""PSS52P6"",$J)") S PSS(1)=0
|
||
|
|
..F S PSS(1)=$O(^TMP("PSS52P6",$J,52.6,PSS(1))) Q:'PSS(1) D
|
||
|
|
...S ^TMP($J,LIST,+PSS(1),.01)=^TMP("PSS52P6",$J,52.6,PSS(1),.01,"E")
|
||
|
|
...S ^TMP($J,LIST,"B",^TMP("PSS52P6",$J,52.6,PSS(1),.01,"E"),+PSS(1))=""
|
||
|
|
...S PSS(3)=0 F S PSS(3)=$O(^TMP("PSS52P6",$J,52.6,PSS(1),10,PSS(3))) Q:'PSS(3) D SETDRI^PSS52P6A
|
||
|
|
...I '$D(^TMP($J,LIST,+PSS(1),"DRGINF")) S ^TMP($J,LIST,+PSS(1),"DRGINF",0)="-1^NO DATA FOUND"
|
||
|
|
K ^TMP("DILIST",$J),^TMP("PSS52P6",$J)
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
DRGIEN ;
|
||
|
|
S SCR("S")=""
|
||
|
|
I +$G(PSSFL)>0 N ND D SETSCRN^PSS52P6A
|
||
|
|
D FIND^DIC(52.6,,"@;.01","QPX",PSS50,,"AC",SCR("S"),,"")
|
||
|
|
I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
|
||
|
|
I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) N XX S XX=0 F S XX=$O(^TMP("DILIST",$J,XX)) Q:'XX D
|
||
|
|
.S ^TMP($J,LIST,+^TMP("DILIST",$J,XX,0),.01)=$P(^TMP("DILIST",$J,XX,0),"^",2)
|
||
|
|
.S ^TMP($J,LIST,"AC",$P(^TMP("DILIST",$J,XX,0),"^",2),+^TMP("DILIST",$J,XX,0))=""
|
||
|
|
K ^TMP("DILIST",$J)
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
LOOKUP ;
|
||
|
|
S SCR("S")="" N PSSIEN,CNT,CNT2,CNT3,QFLG S CNT3=0
|
||
|
|
I +$G(PSSFL)>0 N ND D SETSCRN^PSS52P6A
|
||
|
|
I +$G(PSS50P7)>0 D FIND^DIC(52.6,,"@;.01","QPX",PSS50P7,,"AOI",SCR("S"),,"")
|
||
|
|
I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
|
||
|
|
N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
|
||
|
|
.S PSSIEN=$P(^TMP("DILIST",$J,PSSXX,0),"^")
|
||
|
|
.K PSS52P6 D GETS^DIQ(52.6,+PSSIEN,"1","I","PSS52P6") S QFLG=0 D CHK:+$G(PSSFL)>0 Q:QFLG
|
||
|
|
.K ^TMP("PSS52P6",$J) D GETS^DIQ(52.6,+PSSIEN,".01;14;6*;9*","IE","^TMP(""PSS52P6"",$J)") S PSS(1)=0 D
|
||
|
|
..F S PSS(1)=$O(^TMP("PSS52P6",$J,52.6,PSS(1))) Q:'PSS(1) D SETZRO2^PSS52P6A S CNT3=CNT3+1
|
||
|
|
..S ^TMP($J,LIST,0)=$S(CNT3>0:CNT3,1:"-1^NO DATA FOUND")
|
||
|
|
..S (PSS(2),CNT)=0 F S PSS(2)=$O(^TMP("PSS52P6",$J,52.61,PSS(2))) Q:'PSS(2) D SETQCD2^PSS52P6A S CNT=CNT+1
|
||
|
|
..S ^TMP($J,LIST,+PSSIEN,"QCODE",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
|
||
|
|
..S (PSS(3),CNT2)=0 F S PSS(3)=$O(^TMP("PSS52P6",$J,52.63,PSS(3))) Q:'PSS(3) D SETSYN2^PSS52P6A S CNT2=CNT2+1
|
||
|
|
..S ^TMP($J,LIST,+PSSIEN,"SYN",0)=$S(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
|
||
|
|
K ^TMP("DILIST",$J),^TMP("PSS52P6",$J)
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
POI ;
|
||
|
|
S SCR("S")=""
|
||
|
|
I +$G(PSSFL)>0 N ND D SETSCRN^PSS52P6A
|
||
|
|
D FIND^DIC(52.6,,"@;.01","QPX",PSSOI,,"AOI",SCR("S"),,"")
|
||
|
|
I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
|
||
|
|
I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) N XX S XX=0 F S XX=$O(^TMP("DILIST",$J,XX)) Q:'XX D
|
||
|
|
.S ^TMP($J,LIST,+^TMP("DILIST",$J,XX,0),.01)=$P(^TMP("DILIST",$J,XX,0),"^",2)
|
||
|
|
.S ^TMP($J,LIST,"AOI",$P(^TMP("DILIST",$J,XX,0),"^",2),+^TMP("DILIST",$J,XX,0))=""
|
||
|
|
K ^TMP("DILIST",$J)
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
CHK ;
|
||
|
|
N PSS,PSS50,PSSINACT S PSS=0 F S PSS=$O(PSS52P6(52.6,PSS)) Q:'PSS D
|
||
|
|
.S PSS50=$S($G(PSS52P6(52.6,PSS,1,"I"))]"":$G(PSS52P6(52.6,PSS,1,"I")),1:"")
|
||
|
|
.I +$G(PSS50)'>0 S QFLG=1 Q
|
||
|
|
.D GETS^DIQ(50,+PSS50,"100","I","PSSINACT")
|
||
|
|
.S PSS(4)=0 F S PSS(4)=$O(PSSINACT(50,PSS(4))) Q:'PSS(4) D
|
||
|
|
..S PSSINACT(1)=$G(PSSINACT(50,PSS(4),1,"I")) I PSSINACT(1)'="",(PSSINACT(1)>+$G(PSSFL)) S QFLG=1
|
||
|
|
Q
|