PSS51 ;BIR/LDT - API FOR INFORMATION FROM FILE 51; 5 Sep 03
;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
;
ALL(PSSIEN,PSSFT,LIST) ;
;PSSIEN - IEN of entry in MEDICATION INSTRUCTION file (#51).
;PSSFT - Free Text name in MEDICATION INSTRUCTION file (#51).
;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
;Field Number of the data piece being returned.
;Returns NAME field (#.01), SYNONYM field (#.05), EXPANSION field (#1), OTHER LANGUAGE EXPANSION field (#1.1),
;MED ROUTE field (#2), SCHEDULE field (#3), INSTRUCTIONS field (#4), ADDITIONAL INSTRUCTION field (#5),
;PLURAL field (#9), DEFAULT ADMIN TIMES field (#10), INTENDED USE field (#30), and FREQUENCY (IN MINUTES)
;field (#31) of MEDICATION INSTRUCTION file (#51).
N DIERR,ZZERR,PSS51,PSS
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
I $G(PSSIEN)]"",+$G(PSSIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(51,"","A","`"_PSSIEN,,,"") D
.I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
.S ^TMP($J,LIST,0)=1
.D GETS^DIQ(51,+PSSIEN2,".01;1;.5;30;2;3;4;31;10;5;1.1;9","IE","PSS51") S PSS(1)=0
.F S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1) D SETZRO
I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
.I PSSFT["??" D LOOP(1) Q
.D FIND^DIC(51,,"@;.01;1","QP",PSSFT,,"B",,,"")
.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 PSS51 D GETS^DIQ(51,+PSSIEN,".01;1;.5;30;2;3;4;31;10;5;1.1;9","IE","PSS51") S PSS(1)=0
..F S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1) D SETZRO
K ^TMP("DILIST",$J)
Q
;
WARD(PSSIEN,PSSFT,LIST) ;
;PSSIEN - IEN of entry in MEDICATION INSTRUCTION file (#51).
;PSSFT - Free Text name in MEDICATION INSTRUCTION file (#51).
;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
;Field Number of the data piece being returned.
;Returns NAME field (#.01), WARD field (#.01), and DEFAULT ADMIN TIMES field (#.02) of WARD multiple (#51.01)
;of MEDICATION INSTRUCTION file (#51).
N DIERR,ZZERR,PSS51,PSS,CNT
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
I $G(PSSIEN)]"",+$G(PSSIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(51,"","A","`"_PSSIEN,,,"") D
.I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
.S ^TMP($J,LIST,0)=1
.D GETS^DIQ(51,+PSSIEN2,".01;20*","IE","PSS51") S PSS(1)=0
.F S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1) D SETWARD1 S PSS(2)=0,CNT=0 D
..F S PSS(2)=$O(PSS51(51.01,PSS(2))) Q:'PSS(2) D SETWARD2 S CNT=CNT+1
..S ^TMP($J,LIST,+PSS(1),"WARD",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
.I PSSFT["??" D LOOP(2) Q
.D FIND^DIC(51,,"@;.01","QP",PSSFT,,"B",,,"")
.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 PSS51 D GETS^DIQ(51,+PSSIEN,".01;20*","IE","PSS51") S PSS(1)=0
..F S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1) D SETWARD1 S PSS(2)=0,CNT=0 D
...F S PSS(2)=$O(PSS51(51.01,PSS(2))) Q:'PSS(2) D SETWARD2 S CNT=CNT+1
...S ^TMP($J,LIST,+PSS(1),"WARD",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
K ^TMP("DILIST",$J)
Q
;
LOOKUP(PSSIEN,PSSFT,LIST) ;
;PSSIEN - IEN of entry in MEDICATION INSTRUCTION file (#51).
;PSSFT - Free Text name in MEDICATION INSTRUCTION file (#51).
;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
;Field Number of the data piece being returned.
;Returns NAME field (#.01), and EXPANSION field (#1) of MEDICATION INSTRUCTION file (#51).
N DIERR,ZZERR,PSS51,PSS
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
I $G(PSSIEN)]"",+$G(PSSIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(51,"","A","`"_PSSIEN,,,"") D
.I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
.S ^TMP($J,LIST,0)=1
.D GETS^DIQ(51,+PSSIEN2,".01;1","IE","PSS51") S PSS(1)=0
.F S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1) D SETZRO2
I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
.I PSSFT["??" D LOOP(3) Q
.D FIND^DIC(51,,"@;.01;1","QP",PSSFT,,"B",,,"")
.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 PSS51 D GETS^DIQ(51,+PSSIEN,".01;1","IE","PSS51") S PSS(1)=0
..F S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1) D SETZRO2
K ^TMP("DILIST",$J)
Q
;
CHK(PSSFT,LIST) ;
;PSSFT - Free Text name in MEDICATION INSTRUCTION file (#51).
;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
;Field Number of the data piece being returned.
;Returns NAME field (#.01) of MEDICATION INSTRUCTION file (#51).
N DIERR,ZZERR,PSS51,SCR,PSS
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I $G(PSSFT)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
S SCR("S")="I $P($G(^PS(51,+Y,0)),""^"",4)<2"
I PSSFT["??" D LOOP(4) Q
D FIND^DIC(51,,"@;.01","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 PSS51 D GETS^DIQ(51,+PSSIEN,".01","IE","PSS51") S PSS(1)=0
.F S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1) D
..S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS51(51,PSS(1),.01,"I"))
..S ^TMP($J,LIST,"B",$G(PSS51(51,PSS(1),.01,"I")),+PSS(1))=""
Q
;
SETZRO ;
S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS51(51,PSS(1),.01,"I"))
S ^TMP($J,LIST,"B",$G(PSS51(51,PSS(1),.01,"I")),+PSS(1))=""
S ^TMP($J,LIST,+PSS(1),1)=$G(PSS51(51,PSS(1),1,"I"))
S ^TMP($J,LIST,+PSS(1),.5)=$G(PSS51(51,PSS(1),.5,"I"))
S ^TMP($J,LIST,+PSS(1),30)=$S($G(PSS51(51,PSS(1),30,"I"))="":"",1:PSS51(51,PSS(1),30,"I")_"^"_PSS51(51,PSS(1),30,"E"))
S ^TMP($J,LIST,+PSS(1),2)=$S($G(PSS51(51,PSS(1),2,"I"))="":"",1:PSS51(51,PSS(1),2,"I")_"^"_PSS51(51,PSS(1),2,"E"))
S ^TMP($J,LIST,+PSS(1),3)=$G(PSS51(51,PSS(1),3,"I"))
S ^TMP($J,LIST,+PSS(1),4)=$G(PSS51(51,PSS(1),4,"I"))
S ^TMP($J,LIST,+PSS(1),31)=$G(PSS51(51,PSS(1),31,"I"))
S ^TMP($J,LIST,+PSS(1),5)=$G(PSS51(51,PSS(1),5,"I"))
S ^TMP($J,LIST,+PSS(1),1.1)=$G(PSS51(51,PSS(1),1.1,"I"))
S ^TMP($J,LIST,+PSS(1),10)=$G(PSS51(51,PSS(1),10,"I"))
S ^TMP($J,LIST,+PSS(1),9)=$G(PSS51(51,PSS(1),9,"I"))
Q
;
SETWARD1 ;
S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS51(51,PSS(1),.01,"I"))
S ^TMP($J,LIST,"B",$G(PSS51(51,PSS(1),.01,"I")),+PSS(1))=""
Q
;
SETWARD2 ;
S ^TMP($J,LIST,+PSS(1),"WARD",+PSS(2),.01)=$S($G(PSS51(51.01,PSS(2),.01,"I"))="":"",1:PSS51(51.01,PSS(2),.01,"I")_"^"_PSS51(51.01,PSS(2),.01,"E"))
S ^TMP($J,LIST,+PSS(1),"WARD",+PSS(2),.02)=$G(PSS51(51.01,PSS(2),.02,"I"))
Q
;
SETZRO2 ;
S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS51(51,PSS(1),.01,"I"))
S ^TMP($J,LIST,"B",$G(PSS51(51,PSS(1),.01,"I")),+PSS(1))=""
S ^TMP($J,LIST,+PSS(1),1)=$G(PSS51(51,PSS(1),1,"I"))
Q
;
LOOP(PSS) ;
N CNT,PSSIEN S CNT=0
S PSSIEN=0 F S PSSIEN=$O(^PS(51,PSSIEN)) Q:'PSSIEN D @PSS
S ^TMP($J,LIST,0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
Q
1 ;
K PSS51 D GETS^DIQ(51,+PSSIEN,".01;1;.5;30;2;3;4;31;10;5;1.1;9","IE","PSS51") S PSS(1)=0
F S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1) D SETZRO S CNT=CNT+1
Q
;
2 ;
N CNT2 S CNT2=0
K PSS51 D GETS^DIQ(51,+PSSIEN,".01;20*","IE","PSS51") S PSS(1)=0
F S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1) D SETWARD1 S CNT=CNT+1,PSS(2)=0 D
.F S PSS(2)=$O(PSS51(51.01,PSS(2))) Q:'PSS(2) D SETWARD2 S CNT2=CNT2+1
.S ^TMP($J,LIST,+PSS(1),"WARD",0)=$S(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
Q
;
3 ;
K PSS51 D GETS^DIQ(51,+PSSIEN,".01;1","IE","PSS51") S PSS(1)=0
F S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1) D SETZRO2 S CNT=CNT+1
Q
;
4 ;
Q:$P($G(^PS(51,+PSSIEN,0)),"^",4)>1
K PSS51 D GETS^DIQ(51,+PSSIEN,".01","IE","PSS51") S PSS(1)=0
F S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1) D
.S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS51(51,PSS(1),.01,"I"))
.S ^TMP($J,LIST,"B",$G(PSS51(51,PSS(1),.01,"I")),+PSS(1))=""
.S CNT=CNT+1
Q
;
A(PSSFT,LIST) ;
;PSSFT - Free Text Name in Medication Instruction file (#51).
;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,
;Returns NAME field (#.01), EXPANSION field (#1), OTHER LANGUAGE EXPANSION field (#1.1), and PLURAL field (#9)
;of MEDICATION INSTRUCTION file (#51).
N PSSAENT,PSSAENTN
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I $G(PSSFT)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
I '$D(^PS(51,"A",PSSFT)) S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
S PSSAENT=$O(^PS(51,"B",PSSFT,0)) I 'PSSAENT S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
S PSSAENTN=$G(^PS(51,PSSAENT,0)) I $P(PSSAENTN,"^")="" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
S ^TMP($J,LIST,0)=1
S ^TMP($J,LIST,+PSSAENT,.01)=$P(PSSAENTN,"^")
S ^TMP($J,LIST,"A",$P(PSSAENTN,"^"),+PSSAENT)=""
S ^TMP($J,LIST,+PSSAENT,1)=$P(PSSAENTN,"^",2)
S ^TMP($J,LIST,+PSSAENT,1.1)=$P($G(^PS(51,+PSSAENT,4)),"^")
S ^TMP($J,LIST,+PSSAENT,9)=$P($G(^PS(51,+PSSAENT,9)),"^")
Q
PSS51 ;BIR/LDT - API FOR INFORMATION FROM FILE 51; 5 Sep 03
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
+2 ;
ALL(PSSIEN,PSSFT,LIST) ;
+1 ;PSSIEN - IEN of entry in MEDICATION INSTRUCTION file (#51).
+2 ;PSSFT - Free Text name in MEDICATION INSTRUCTION file (#51).
+3 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
+4 ;Field Number of the data piece being returned.
+5 ;Returns NAME field (#.01), SYNONYM field (#.05), EXPANSION field (#1), OTHER LANGUAGE EXPANSION field (#1.1),
+6 ;MED ROUTE field (#2), SCHEDULE field (#3), INSTRUCTIONS field (#4), ADDITIONAL INSTRUCTION field (#5),
+7 ;PLURAL field (#9), DEFAULT ADMIN TIMES field (#10), INTENDED USE field (#30), and FREQUENCY (IN MINUTES)
+8 ;field (#31) of MEDICATION INSTRUCTION file (#51).
+9 NEW DIERR,ZZERR,PSS51,PSS
+10 IF $GET(LIST)']""
QUIT
+11 KILL ^TMP($JOB,LIST)
+12 IF +$GET(PSSIEN)'>0
IF ($GET(PSSFT)']"")
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+13 IF $GET(PSSIEN)]""
IF +$GET(PSSIEN)'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+14 IF +$GET(PSSIEN)>0
NEW PSSIEN2
SET PSSIEN2=$$FIND1^DIC(51,"","A","`"_PSSIEN,,,"")
Begin DoDot:1
+15 IF +PSSIEN2'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+16 SET ^TMP($JOB,LIST,0)=1
+17 DO GETS^DIQ(51,+PSSIEN2,".01;1;.5;30;2;3;4;31;10;5;1.1;9","IE","PSS51")
SET PSS(1)=0
+18 FOR
SET PSS(1)=$ORDER(PSS51(51,PSS(1)))
IF 'PSS(1)
QUIT
DO SETZRO
End DoDot:1
+19 IF +$GET(PSSIEN)'>0
IF $GET(PSSFT)]""
Begin DoDot:1
+20 IF PSSFT["??"
DO LOOP(1)
QUIT
+21 DO FIND^DIC(51,,"@;.01;1","QP",PSSFT,,"B",,,"")
+22 IF +$GET(^TMP("DILIST",$JOB,0))=0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+23 IF +^TMP("DILIST",$JOB,0)>0
SET ^TMP($JOB,LIST,0)=+^TMP("DILIST",$JOB,0)
NEW PSSXX
SET PSSXX=0
FOR
SET PSSXX=$ORDER(^TMP("DILIST",$JOB,PSSXX))
IF 'PSSXX
QUIT
Begin DoDot:2
+24 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
KILL PSS51
DO GETS^DIQ(51,+PSSIEN,".01;1;.5;30;2;3;4;31;10;5;1.1;9","IE","PSS51")
SET PSS(1)=0
+25 FOR
SET PSS(1)=$ORDER(PSS51(51,PSS(1)))
IF 'PSS(1)
QUIT
DO SETZRO
End DoDot:2
End DoDot:1
+26 KILL ^TMP("DILIST",$JOB)
+27 QUIT
+28 ;
WARD(PSSIEN,PSSFT,LIST) ;
+1 ;PSSIEN - IEN of entry in MEDICATION INSTRUCTION file (#51).
+2 ;PSSFT - Free Text name in MEDICATION INSTRUCTION file (#51).
+3 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
+4 ;Field Number of the data piece being returned.
+5 ;Returns NAME field (#.01), WARD field (#.01), and DEFAULT ADMIN TIMES field (#.02) of WARD multiple (#51.01)
+6 ;of MEDICATION INSTRUCTION file (#51).
+7 NEW DIERR,ZZERR,PSS51,PSS,CNT
+8 IF $GET(LIST)']""
QUIT
+9 KILL ^TMP($JOB,LIST)
+10 IF +$GET(PSSIEN)'>0
IF ($GET(PSSFT)']"")
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+11 IF $GET(PSSIEN)]""
IF +$GET(PSSIEN)'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+12 IF +$GET(PSSIEN)>0
NEW PSSIEN2
SET PSSIEN2=$$FIND1^DIC(51,"","A","`"_PSSIEN,,,"")
Begin DoDot:1
+13 IF +PSSIEN2'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+14 SET ^TMP($JOB,LIST,0)=1
+15 DO GETS^DIQ(51,+PSSIEN2,".01;20*","IE","PSS51")
SET PSS(1)=0
+16 FOR
SET PSS(1)=$ORDER(PSS51(51,PSS(1)))
IF 'PSS(1)
QUIT
DO SETWARD1
SET PSS(2)=0
SET CNT=0
Begin DoDot:2
+17 FOR
SET PSS(2)=$ORDER(PSS51(51.01,PSS(2)))
IF 'PSS(2)
QUIT
DO SETWARD2
SET CNT=CNT+1
+18 SET ^TMP($JOB,LIST,+PSS(1),"WARD",0)=$SELECT(CNT>0:CNT,1:"-1^NO DATA FOUND")
End DoDot:2
End DoDot:1
+19 IF +$GET(PSSIEN)'>0
IF $GET(PSSFT)]""
Begin DoDot:1
+20 IF PSSFT["??"
DO LOOP(2)
QUIT
+21 DO FIND^DIC(51,,"@;.01","QP",PSSFT,,"B",,,"")
+22 IF +$GET(^TMP("DILIST",$JOB,0))=0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+23 IF +^TMP("DILIST",$JOB,0)>0
SET ^TMP($JOB,LIST,0)=+^TMP("DILIST",$JOB,0)
NEW PSSXX
SET PSSXX=0
FOR
SET PSSXX=$ORDER(^TMP("DILIST",$JOB,PSSXX))
IF 'PSSXX
QUIT
Begin DoDot:2
+24 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
KILL PSS51
DO GETS^DIQ(51,+PSSIEN,".01;20*","IE","PSS51")
SET PSS(1)=0
+25 FOR
SET PSS(1)=$ORDER(PSS51(51,PSS(1)))
IF 'PSS(1)
QUIT
DO SETWARD1
SET PSS(2)=0
SET CNT=0
Begin DoDot:3
+26 FOR
SET PSS(2)=$ORDER(PSS51(51.01,PSS(2)))
IF 'PSS(2)
QUIT
DO SETWARD2
SET CNT=CNT+1
+27 SET ^TMP($JOB,LIST,+PSS(1),"WARD",0)=$SELECT(CNT>0:CNT,1:"-1^NO DATA FOUND")
End DoDot:3
End DoDot:2
End DoDot:1
+28 KILL ^TMP("DILIST",$JOB)
+29 QUIT
+30 ;
LOOKUP(PSSIEN,PSSFT,LIST) ;
+1 ;PSSIEN - IEN of entry in MEDICATION INSTRUCTION file (#51).
+2 ;PSSFT - Free Text name in MEDICATION INSTRUCTION file (#51).
+3 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
+4 ;Field Number of the data piece being returned.
+5 ;Returns NAME field (#.01), and EXPANSION field (#1) of MEDICATION INSTRUCTION file (#51).
+6 NEW DIERR,ZZERR,PSS51,PSS
+7 IF $GET(LIST)']""
QUIT
+8 KILL ^TMP($JOB,LIST)
+9 IF +$GET(PSSIEN)'>0
IF ($GET(PSSFT)']"")
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+10 IF $GET(PSSIEN)]""
IF +$GET(PSSIEN)'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+11 IF +$GET(PSSIEN)>0
NEW PSSIEN2
SET PSSIEN2=$$FIND1^DIC(51,"","A","`"_PSSIEN,,,"")
Begin DoDot:1
+12 IF +PSSIEN2'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+13 SET ^TMP($JOB,LIST,0)=1
+14 DO GETS^DIQ(51,+PSSIEN2,".01;1","IE","PSS51")
SET PSS(1)=0
+15 FOR
SET PSS(1)=$ORDER(PSS51(51,PSS(1)))
IF 'PSS(1)
QUIT
DO SETZRO2
End DoDot:1
+16 IF +$GET(PSSIEN)'>0
IF $GET(PSSFT)]""
Begin DoDot:1
+17 IF PSSFT["??"
DO LOOP(3)
QUIT
+18 DO FIND^DIC(51,,"@;.01;1","QP",PSSFT,,"B",,,"")
+19 IF +$GET(^TMP("DILIST",$JOB,0))=0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+20 IF +^TMP("DILIST",$JOB,0)>0
SET ^TMP($JOB,LIST,0)=+^TMP("DILIST",$JOB,0)
NEW PSSXX
SET PSSXX=0
FOR
SET PSSXX=$ORDER(^TMP("DILIST",$JOB,PSSXX))
IF 'PSSXX
QUIT
Begin DoDot:2
+21 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
KILL PSS51
DO GETS^DIQ(51,+PSSIEN,".01;1","IE","PSS51")
SET PSS(1)=0
+22 FOR
SET PSS(1)=$ORDER(PSS51(51,PSS(1)))
IF 'PSS(1)
QUIT
DO SETZRO2
End DoDot:2
End DoDot:1
+23 KILL ^TMP("DILIST",$JOB)
+24 QUIT
+25 ;
CHK(PSSFT,LIST) ;
+1 ;PSSFT - Free Text name in MEDICATION INSTRUCTION file (#51).
+2 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
+3 ;Field Number of the data piece being returned.
+4 ;Returns NAME field (#.01) of MEDICATION INSTRUCTION file (#51).
+5 NEW DIERR,ZZERR,PSS51,SCR,PSS
+6 IF $GET(LIST)']""
QUIT
+7 KILL ^TMP($JOB,LIST)
+8 IF $GET(PSSFT)']""
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+9 SET SCR("S")="I $P($G(^PS(51,+Y,0)),""^"",4)<2"
+10 IF PSSFT["??"
DO LOOP(4)
QUIT
+11 DO FIND^DIC(51,,"@;.01","QP",PSSFT,,"B",SCR("S"),,"")
+12 IF +$GET(^TMP("DILIST",$JOB,0))=0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+13 IF +^TMP("DILIST",$JOB,0)>0
SET ^TMP($JOB,LIST,0)=+^TMP("DILIST",$JOB,0)
NEW PSSXX
SET PSSXX=0
FOR
SET PSSXX=$ORDER(^TMP("DILIST",$JOB,PSSXX))
IF 'PSSXX
QUIT
Begin DoDot:1
+14 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
KILL PSS51
DO GETS^DIQ(51,+PSSIEN,".01","IE","PSS51")
SET PSS(1)=0
+15 FOR
SET PSS(1)=$ORDER(PSS51(51,PSS(1)))
IF 'PSS(1)
QUIT
Begin DoDot:2
+16 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(PSS51(51,PSS(1),.01,"I"))
+17 SET ^TMP($JOB,LIST,"B",$GET(PSS51(51,PSS(1),.01,"I")),+PSS(1))=""
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
SETZRO ;
+1 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(PSS51(51,PSS(1),.01,"I"))
+2 SET ^TMP($JOB,LIST,"B",$GET(PSS51(51,PSS(1),.01,"I")),+PSS(1))=""
+3 SET ^TMP($JOB,LIST,+PSS(1),1)=$GET(PSS51(51,PSS(1),1,"I"))
+4 SET ^TMP($JOB,LIST,+PSS(1),.5)=$GET(PSS51(51,PSS(1),.5,"I"))
+5 SET ^TMP($JOB,LIST,+PSS(1),30)=$SELECT($GET(PSS51(51,PSS(1),30,"I"))="":"",1:PSS51(51,PSS(1),30,"I")_"^"_PSS51(51,PSS(1),30,"E"))
+6 SET ^TMP($JOB,LIST,+PSS(1),2)=$SELECT($GET(PSS51(51,PSS(1),2,"I"))="":"",1:PSS51(51,PSS(1),2,"I")_"^"_PSS51(51,PSS(1),2,"E"))
+7 SET ^TMP($JOB,LIST,+PSS(1),3)=$GET(PSS51(51,PSS(1),3,"I"))
+8 SET ^TMP($JOB,LIST,+PSS(1),4)=$GET(PSS51(51,PSS(1),4,"I"))
+9 SET ^TMP($JOB,LIST,+PSS(1),31)=$GET(PSS51(51,PSS(1),31,"I"))
+10 SET ^TMP($JOB,LIST,+PSS(1),5)=$GET(PSS51(51,PSS(1),5,"I"))
+11 SET ^TMP($JOB,LIST,+PSS(1),1.1)=$GET(PSS51(51,PSS(1),1.1,"I"))
+12 SET ^TMP($JOB,LIST,+PSS(1),10)=$GET(PSS51(51,PSS(1),10,"I"))
+13 SET ^TMP($JOB,LIST,+PSS(1),9)=$GET(PSS51(51,PSS(1),9,"I"))
+14 QUIT
+15 ;
SETWARD1 ;
+1 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(PSS51(51,PSS(1),.01,"I"))
+2 SET ^TMP($JOB,LIST,"B",$GET(PSS51(51,PSS(1),.01,"I")),+PSS(1))=""
+3 QUIT
+4 ;
SETWARD2 ;
+1 SET ^TMP($JOB,LIST,+PSS(1),"WARD",+PSS(2),.01)=$SELECT($GET(PSS51(51.01,PSS(2),.01,"I"))="":"",1:PSS51(51.01,PSS(2),.01,"I")_"^"_PSS51(51.01,PSS(2),.01,"E"))
+2 SET ^TMP($JOB,LIST,+PSS(1),"WARD",+PSS(2),.02)=$GET(PSS51(51.01,PSS(2),.02,"I"))
+3 QUIT
+4 ;
SETZRO2 ;
+1 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(PSS51(51,PSS(1),.01,"I"))
+2 SET ^TMP($JOB,LIST,"B",$GET(PSS51(51,PSS(1),.01,"I")),+PSS(1))=""
+3 SET ^TMP($JOB,LIST,+PSS(1),1)=$GET(PSS51(51,PSS(1),1,"I"))
+4 QUIT
+5 ;
LOOP(PSS) ;
+1 NEW CNT,PSSIEN
SET CNT=0
+2 SET PSSIEN=0
FOR
SET PSSIEN=$ORDER(^PS(51,PSSIEN))
IF 'PSSIEN
QUIT
DO @PSS
+3 SET ^TMP($JOB,LIST,0)=$SELECT(CNT>0:CNT,1:"-1^NO DATA FOUND")
+4 QUIT
1 ;
+1 KILL PSS51
DO GETS^DIQ(51,+PSSIEN,".01;1;.5;30;2;3;4;31;10;5;1.1;9","IE","PSS51")
SET PSS(1)=0
+2 FOR
SET PSS(1)=$ORDER(PSS51(51,PSS(1)))
IF 'PSS(1)
QUIT
DO SETZRO
SET CNT=CNT+1
+3 QUIT
+4 ;
2 ;
+1 NEW CNT2
SET CNT2=0
+2 KILL PSS51
DO GETS^DIQ(51,+PSSIEN,".01;20*","IE","PSS51")
SET PSS(1)=0
+3 FOR
SET PSS(1)=$ORDER(PSS51(51,PSS(1)))
IF 'PSS(1)
QUIT
DO SETWARD1
SET CNT=CNT+1
SET PSS(2)=0
Begin DoDot:1
+4 FOR
SET PSS(2)=$ORDER(PSS51(51.01,PSS(2)))
IF 'PSS(2)
QUIT
DO SETWARD2
SET CNT2=CNT2+1
+5 SET ^TMP($JOB,LIST,+PSS(1),"WARD",0)=$SELECT(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
End DoDot:1
+6 QUIT
+7 ;
3 ;
+1 KILL PSS51
DO GETS^DIQ(51,+PSSIEN,".01;1","IE","PSS51")
SET PSS(1)=0
+2 FOR
SET PSS(1)=$ORDER(PSS51(51,PSS(1)))
IF 'PSS(1)
QUIT
DO SETZRO2
SET CNT=CNT+1
+3 QUIT
+4 ;
4 ;
+1 IF $PIECE($GET(^PS(51,+PSSIEN,0)),"^",4)>1
QUIT
+2 KILL PSS51
DO GETS^DIQ(51,+PSSIEN,".01","IE","PSS51")
SET PSS(1)=0
+3 FOR
SET PSS(1)=$ORDER(PSS51(51,PSS(1)))
IF 'PSS(1)
QUIT
Begin DoDot:1
+4 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(PSS51(51,PSS(1),.01,"I"))
+5 SET ^TMP($JOB,LIST,"B",$GET(PSS51(51,PSS(1),.01,"I")),+PSS(1))=""
+6 SET CNT=CNT+1
End DoDot:1
+7 QUIT
+8 ;
A(PSSFT,LIST) ;
+1 ;PSSFT - Free Text Name in Medication Instruction file (#51).
+2 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,
+3 ;Returns NAME field (#.01), EXPANSION field (#1), OTHER LANGUAGE EXPANSION field (#1.1), and PLURAL field (#9)
+4 ;of MEDICATION INSTRUCTION file (#51).
+5 NEW PSSAENT,PSSAENTN
+6 IF $GET(LIST)']""
QUIT
+7 KILL ^TMP($JOB,LIST)
+8 IF $GET(PSSFT)']""
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+9 IF '$DATA(^PS(51,"A",PSSFT))
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+10 SET PSSAENT=$ORDER(^PS(51,"B",PSSFT,0))
IF 'PSSAENT
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+11 SET PSSAENTN=$GET(^PS(51,PSSAENT,0))
IF $PIECE(PSSAENTN,"^")=""
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+12 SET ^TMP($JOB,LIST,0)=1
+13 SET ^TMP($JOB,LIST,+PSSAENT,.01)=$PIECE(PSSAENTN,"^")
+14 SET ^TMP($JOB,LIST,"A",$PIECE(PSSAENTN,"^"),+PSSAENT)=""
+15 SET ^TMP($JOB,LIST,+PSSAENT,1)=$PIECE(PSSAENTN,"^",2)
+16 SET ^TMP($JOB,LIST,+PSSAENT,1.1)=$PIECE($GET(^PS(51,+PSSAENT,4)),"^")
+17 SET ^TMP($JOB,LIST,+PSSAENT,9)=$PIECE($GET(^PS(51,+PSSAENT,9)),"^")
+18 QUIT
