PSS51P1C ;BIR/LDT - API FOR INFORMATION FROM FILE 51.1; 5 Sep 03
;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
;
ALL ;
I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(51.1,"","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.1,+PSSIEN2,".01;1;2;4;5;6;2.5;8;8.1;3*;7*","IE","^TMP(""PSS51P1"",$J)") S PSS(1)=0
.F S PSS(1)=$O(^TMP("PSS51P1",$J,51.1,PSS(1))) Q:'PSS(1) D SETZRO
.S (CNT2,PSS(2))=0 F S PSS(2)=$O(^TMP("PSS51P1",$J,51.11,PSS(2))) Q:'PSS(2) D SETWARD S CNT2=CNT2+1
.S ^TMP($J,LIST,+PSSIEN,"WARD",0)=$S(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
.S (CNT3,PSS(3))=0 F S PSS(3)=$O(^TMP("PSS51P1",$J,51.17,PSS(3))) Q:'PSS(3) D SETLOC S CNT3=CNT3+1
.S ^TMP($J,LIST,+PSSIEN,"HOSP",0)=$S(CNT3>0:CNT3,1:"-1^NO DATA FOUND")
I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
.I PSSFT["??" D LOOP(1) Q
.D FIND^DIC(51.1,,"@;.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 ^TMP("PSS51P1",$J) D GETS^DIQ(51.1,+PSSIEN,".01;1;2;4;5;6;2.5;8;8.1;3*;7*","IE","^TMP(""PSS51P1"",$J)") S PSS(1)=0
..F S PSS(1)=$O(^TMP("PSS51P1",$J,51.1,PSS(1))) Q:'PSS(1) D SETZRO
..S (CNT2,PSS(2))=0 F S PSS(2)=$O(^TMP("PSS51P1",$J,51.11,PSS(2))) Q:'PSS(2) D SETWARD S CNT2=CNT2+1
..S ^TMP($J,LIST,+PSSIEN,"WARD",0)=$S(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
..S (CNT3,PSS(3))=0 F S PSS(3)=$O(^TMP("PSS51P1",$J,51.17,PSS(3))) Q:'PSS(3) D SETLOC S CNT3=CNT3+1
..S ^TMP($J,LIST,+PSSIEN,"HOSP",0)=$S(CNT3>0:CNT3,1:"-1^NO DATA FOUND")
K ^TMP("DILIST",$J),^TMP("PSS51P1",$J)
Q
;
SETZRO ;
S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSS51P1",$J,51.1,PSS(1),.01,"I"))
S ^TMP($J,LIST,"B",$G(^TMP("PSS51P1",$J,51.1,PSS(1),.01,"I")),+PSS(1))=""
S ^TMP($J,LIST,+PSS(1),1)=$G(^TMP("PSS51P1",$J,51.1,PSS(1),1,"I"))
S ^TMP($J,LIST,+PSS(1),2)=$G(^TMP("PSS51P1",$J,51.1,PSS(1),2,"I"))
S ^TMP($J,LIST,+PSS(1),4)=$G(^TMP("PSS51P1",$J,51.1,PSS(1),4,"I"))
S ^TMP($J,LIST,+PSS(1),5)=$S($G(^TMP("PSS51P1",$J,51.1,PSS(1),5,"I"))="":"",1:^TMP("PSS51P1",$J,51.1,PSS(1),5,"I")_"^"_^TMP("PSS51P1",$J,51.1,PSS(1),5,"E"))
S ^TMP($J,LIST,+PSS(1),6)=$G(^TMP("PSS51P1",$J,51.1,PSS(1),6,"I"))
S ^TMP($J,LIST,+PSS(1),2.5)=$G(^TMP("PSS51P1",$J,51.1,PSS(1),2.5,"I"))
S ^TMP($J,LIST,+PSS(1),8)=$G(^TMP("PSS51P1",$J,51.1,PSS(1),8,"I"))
S ^TMP($J,LIST,+PSS(1),8.1)=$G(^TMP("PSS51P1",$J,51.1,PSS(1),8.1,"I"))
Q
;
SETWARD ;
S ^TMP($J,LIST,+PSSIEN,"WARD",+PSS(2),.01)=$S($G(^TMP("PSS51P1",$J,51.11,PSS(2),.01,"I"))="":"",1:^TMP("PSS51P1",$J,51.11,PSS(2),.01,"I")_"^"_^TMP("PSS51P1",$J,51.11,PSS(2),.01,"E"))
S ^TMP($J,LIST,+PSSIEN,"WARD",+PSS(2),1)=$G(^TMP("PSS51P1",$J,51.11,PSS(2),1,"I"))
Q
;
SETLOC ;
S ^TMP($J,LIST,+PSSIEN,"HOSP",+PSS(3),.01)=$S($G(^TMP("PSS51P1",$J,51.17,PSS(3),.01,"I"))="":"",1:^TMP("PSS51P1",$J,51.17,PSS(3),.01,"I")_"^"_^TMP("PSS51P1",$J,51.17,PSS(3),.01,"E"))
S ^TMP($J,LIST,+PSSIEN,"HOSP",+PSS(3),1)=$G(^TMP("PSS51P1",$J,51.17,PSS(3),1,"I"))
S ^TMP($J,LIST,+PSSIEN,"HOSP",+PSS(3),2)=$G(^TMP("PSS51P1",$J,51.17,PSS(3),2,"I"))
Q
;
LOOP(PSSLP) ;
N CNT,CNT2,CNT3,PSSIEN S (CNT,PSSIEN)=0
F S PSSIEN=$O(^PS(51.1,PSSIEN)) Q:'PSSIEN D @(PSSLP) S CNT=CNT+1
S ^TMP($J,LIST,0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
K ^TMP("DILIST",$J),^TMP("PSS51P1",$J)
Q
1 ;
K ^TMP("PSS51P1",$J) D GETS^DIQ(51.1,+PSSIEN,".01;1;2;4;5;6;2.5;8;8.1;3*;7*","IE","^TMP(""PSS51P1"",$J)") S PSS(1)=0
F S PSS(1)=$O(^TMP("PSS51P1",$J,51.1,PSS(1))) Q:'PSS(1) D SETZRO
S (CNT2,PSS(2))=0 F S PSS(2)=$O(^TMP("PSS51P1",$J,51.11,PSS(2))) Q:'PSS(2) D SETWARD S CNT2=CNT2+1
S ^TMP($J,LIST,+PSSIEN,"WARD",0)=$S(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
S (CNT3,PSS(3))=0 F S PSS(3)=$O(^TMP("PSS51P1",$J,51.17,PSS(3))) Q:'PSS(3) D SETLOC S CNT3=CNT3+1
S ^TMP($J,LIST,+PSSIEN,"HOSP",0)=$S(CNT3>0:CNT3,1:"-1^NO DATA FOUND")
Q
;
WARD ;
I +$G(PSSIEN2)>0,+$G(PSSIEN)>0 D GETS^DIQ(51.11,+PSSIEN2_","_+PSSIEN,".01;1","IE","^TMP($J,""PSS51P1""") D
.D GETS^DIQ(51.1,+PSSIEN,".01","IE","^TMP($J,""PSS51P1""") S PSS(1)=0 F S PSS(1)=$O(^TMP($J,"PSS51P1",51.1,PSS(1))) Q:'PSS(1) D
..S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP($J,"PSS51P1",51.1,PSS(1),.01,"I"))
..S ^TMP($J,LIST,"B",$G(^TMP($J,"PSS51P1",51.1,PSS(1),.01,"E")),+PSS(1))=""
.S PSS(1)=+PSSIEN,PSS(2)=0 F S PSS(2)=$O(^TMP($J,"PSS51P1",51.11,PSS(2))) Q:'PSS(2) D SETWARD^PSS51P1B S CNT=CNT+1
.S ^TMP($J,LIST,+PSSIEN,"WARD",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND FOR PSSIEN2 #"_PSSIEN2)
.S ^TMP($J,LIST,0)=$S($G(^TMP($J,LIST,+PSSIEN,.01))]"":1,1:"-1^NO DATA FOUND")
I +$G(PSSIEN)>0,+$G(PSSIEN2)'>0 N PSSIEN3 S PSSIEN3=$$FIND1^DIC(51.1,"","A","`"_PSSIEN,,,"") D
.I +PSSIEN3'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
.S ^TMP($J,LIST,0)=1
.D GETS^DIQ(51.1,+PSSIEN3,".01;3*","IE","^TMP($J,""PSS51P1""") S PSS(1)=0 D
..F S PSS(1)=$O(^TMP($J,"PSS51P1",51.1,PSS(1))) Q:'PSS(1) S ^TMP($J,LIST,+PSS(1),.01)=^TMP($J,"PSS51P1",51.1,PSS(1),.01,"I") D
...S ^TMP($J,LIST,"B",$G(^TMP($J,"PSS51P1",51.1,PSS(1),.01,"E")),+PSS(1))="" S PSS(2)=0
...F S PSS(2)=$O(^TMP($J,"PSS51P1",51.11,PSS(2))) Q:'PSS(2) D SETWARD^PSS51P1B S CNT=CNT+1
..S ^TMP($J,LIST,+PSSIEN3,"WARD",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
.I PSSFT["??" D LOOP^PSS51P1B(2) Q
.D FIND^DIC(51.1,,"@;.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)
.I +$G(PSSIEN2)'>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($J,"PSS51P1") D GETS^DIQ(51.1,+PSSIEN,".01;3*","IE","^TMP($J,""PSS51P1""") S (PSS(1),CNT)=0 D
...F S PSS(1)=$O(^TMP($J,"PSS51P1",51.1,PSS(1))) Q:'PSS(1) D
....S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP($J,"PSS51P1",51.1,PSS(1),.01,"I"))
....S ^TMP($J,LIST,"B",$G(^TMP($J,"PSS51P1",51.1,PSS(1),.01,"E")),+PSS(1))="" S (PSS(2),CNT)=0 D
.....F S PSS(2)=$O(^TMP($J,"PSS51P1",51.11,PSS(2))) Q:'PSS(2) D SETWARD^PSS51P1B S CNT=CNT+1
.....S ^TMP($J,LIST,+PSS(1),"WARD",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
.I +$G(PSSIEN2)>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($J,"PSS51P1") D GETS^DIQ(51.1,+PSSIEN,".01","IE","^TMP($J,""PSS51P1""")
..S PSS(3)=0 F S PSS(3)=$O(^TMP($J,"PSS51P1",51.1,PSS(3))) Q:'PSS(3) D
...S ^TMP($J,LIST,+PSS(3),.01)=$G(^TMP($J,"PSS51P1",51.1,PSS(3),.01,"I"))
...S ^TMP($J,LIST,"B",$G(^TMP($J,"PSS51P1",51.1,PSS(3),.01,"E")),+PSS(3))=""
...D GETS^DIQ(51.11,+PSSIEN2_","_+PSSIEN,".01;1","IE","^TMP($J,""PSS51P1""")
...S PSS(1)=+PSSIEN,(PSS(2),CNT)=0 F S PSS(2)=$O(^TMP($J,"PSS51P1",51.11,PSS(2))) Q:'PSS(2) D SETWARD^PSS51P1B S CNT=CNT+1
...S ^TMP($J,LIST,+PSSIEN,"WARD",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND FOR PSSIEN2 #"_PSSIEN2)
K ^TMP("DILIST",$J),^TMP($J,"PSS51P1")
Q
PSS51P1C ;BIR/LDT - API FOR INFORMATION FROM FILE 51.1; 5 Sep 03
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
+2 ;
ALL ;
+1 IF +$GET(PSSIEN)>0
NEW PSSIEN2
SET PSSIEN2=$$FIND1^DIC(51.1,"","A","`"_PSSIEN,,,"")
Begin DoDot:1
+2 IF +PSSIEN2'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+3 SET ^TMP($JOB,LIST,0)=1
+4 DO GETS^DIQ(51.1,+PSSIEN2,".01;1;2;4;5;6;2.5;8;8.1;3*;7*","IE","^TMP(""PSS51P1"",$J)")
SET PSS(1)=0
+5 FOR
SET PSS(1)=$ORDER(^TMP("PSS51P1",$JOB,51.1,PSS(1)))
IF 'PSS(1)
QUIT
DO SETZRO
+6 SET (CNT2,PSS(2))=0
FOR
SET PSS(2)=$ORDER(^TMP("PSS51P1",$JOB,51.11,PSS(2)))
IF 'PSS(2)
QUIT
DO SETWARD
SET CNT2=CNT2+1
+7 SET ^TMP($JOB,LIST,+PSSIEN,"WARD",0)=$SELECT(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
+8 SET (CNT3,PSS(3))=0
FOR
SET PSS(3)=$ORDER(^TMP("PSS51P1",$JOB,51.17,PSS(3)))
IF 'PSS(3)
QUIT
DO SETLOC
SET CNT3=CNT3+1
+9 SET ^TMP($JOB,LIST,+PSSIEN,"HOSP",0)=$SELECT(CNT3>0:CNT3,1:"-1^NO DATA FOUND")
End DoDot:1
+10 IF +$GET(PSSIEN)'>0
IF $GET(PSSFT)]""
Begin DoDot:1
+11 IF PSSFT["??"
DO LOOP(1)
QUIT
+12 DO FIND^DIC(51.1,,"@;.01;1","QP",PSSFT,,"B",,,"")
+13 IF +$GET(^TMP("DILIST",$JOB,0))=0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+14 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
+15 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
KILL ^TMP("PSS51P1",$JOB)
DO GETS^DIQ(51.1,+PSSIEN,".01;1;2;4;5;6;2.5;8;8.1;3*;7*","IE","^TMP(""PSS51P1"",$J)")
SET PSS(1)=0
+16 FOR
SET PSS(1)=$ORDER(^TMP("PSS51P1",$JOB,51.1,PSS(1)))
IF 'PSS(1)
QUIT
DO SETZRO
+17 SET (CNT2,PSS(2))=0
FOR
SET PSS(2)=$ORDER(^TMP("PSS51P1",$JOB,51.11,PSS(2)))
IF 'PSS(2)
QUIT
DO SETWARD
SET CNT2=CNT2+1
+18 SET ^TMP($JOB,LIST,+PSSIEN,"WARD",0)=$SELECT(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
+19 SET (CNT3,PSS(3))=0
FOR
SET PSS(3)=$ORDER(^TMP("PSS51P1",$JOB,51.17,PSS(3)))
IF 'PSS(3)
QUIT
DO SETLOC
SET CNT3=CNT3+1
+20 SET ^TMP($JOB,LIST,+PSSIEN,"HOSP",0)=$SELECT(CNT3>0:CNT3,1:"-1^NO DATA FOUND")
End DoDot:2
End DoDot:1
+21 KILL ^TMP("DILIST",$JOB),^TMP("PSS51P1",$JOB)
+22 QUIT
+23 ;
SETZRO ;
+1 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(^TMP("PSS51P1",$JOB,51.1,PSS(1),.01,"I"))
+2 SET ^TMP($JOB,LIST,"B",$GET(^TMP("PSS51P1",$JOB,51.1,PSS(1),.01,"I")),+PSS(1))=""
+3 SET ^TMP($JOB,LIST,+PSS(1),1)=$GET(^TMP("PSS51P1",$JOB,51.1,PSS(1),1,"I"))
+4 SET ^TMP($JOB,LIST,+PSS(1),2)=$GET(^TMP("PSS51P1",$JOB,51.1,PSS(1),2,"I"))
+5 SET ^TMP($JOB,LIST,+PSS(1),4)=$GET(^TMP("PSS51P1",$JOB,51.1,PSS(1),4,"I"))
+6 SET ^TMP($JOB,LIST,+PSS(1),5)=$SELECT($GET(^TMP("PSS51P1",$JOB,51.1,PSS(1),5,"I"))="":"",1:^TMP("PSS51P1",$JOB,51.1,PSS(1),5,"I")_"^"_^TMP("PSS51P1",$JOB,51.1,PSS(1),5,"E"))
+7 SET ^TMP($JOB,LIST,+PSS(1),6)=$GET(^TMP("PSS51P1",$JOB,51.1,PSS(1),6,"I"))
+8 SET ^TMP($JOB,LIST,+PSS(1),2.5)=$GET(^TMP("PSS51P1",$JOB,51.1,PSS(1),2.5,"I"))
+9 SET ^TMP($JOB,LIST,+PSS(1),8)=$GET(^TMP("PSS51P1",$JOB,51.1,PSS(1),8,"I"))
+10 SET ^TMP($JOB,LIST,+PSS(1),8.1)=$GET(^TMP("PSS51P1",$JOB,51.1,PSS(1),8.1,"I"))
+11 QUIT
+12 ;
SETWARD ;
+1 SET ^TMP($JOB,LIST,+PSSIEN,"WARD",+PSS(2),.01)=$SELECT($GET(^TMP("PSS51P1",$JOB,51.11,PSS(2),.01,"I"))="":"",1:^TMP("PSS51P1",$JOB,51.11,PSS(2),.01,"I")_"^"_^TMP("PSS51P1",$JOB,51.11,PSS(2),.01,"E"))
+2 SET ^TMP($JOB,LIST,+PSSIEN,"WARD",+PSS(2),1)=$GET(^TMP("PSS51P1",$JOB,51.11,PSS(2),1,"I"))
+3 QUIT
+4 ;
SETLOC ;
+1 SET ^TMP($JOB,LIST,+PSSIEN,"HOSP",+PSS(3),.01)=$SELECT($GET(^TMP("PSS51P1",$JOB,51.17,PSS(3),.01,"I"))="":"",1:^TMP("PSS51P1",$JOB,51.17,PSS(3),.01,"I")_"^"_^TMP("PSS51P1",$JOB,51.17,PSS(3),.01,"E"))
+2 SET ^TMP($JOB,LIST,+PSSIEN,"HOSP",+PSS(3),1)=$GET(^TMP("PSS51P1",$JOB,51.17,PSS(3),1,"I"))
+3 SET ^TMP($JOB,LIST,+PSSIEN,"HOSP",+PSS(3),2)=$GET(^TMP("PSS51P1",$JOB,51.17,PSS(3),2,"I"))
+4 QUIT
+5 ;
LOOP(PSSLP) ;
+1 NEW CNT,CNT2,CNT3,PSSIEN
SET (CNT,PSSIEN)=0
+2 FOR
SET PSSIEN=$ORDER(^PS(51.1,PSSIEN))
IF 'PSSIEN
QUIT
DO @(PSSLP)
SET CNT=CNT+1
+3 SET ^TMP($JOB,LIST,0)=$SELECT(CNT>0:CNT,1:"-1^NO DATA FOUND")
+4 KILL ^TMP("DILIST",$JOB),^TMP("PSS51P1",$JOB)
+5 QUIT
1 ;
+1 KILL ^TMP("PSS51P1",$JOB)
DO GETS^DIQ(51.1,+PSSIEN,".01;1;2;4;5;6;2.5;8;8.1;3*;7*","IE","^TMP(""PSS51P1"",$J)")
SET PSS(1)=0
+2 FOR
SET PSS(1)=$ORDER(^TMP("PSS51P1",$JOB,51.1,PSS(1)))
IF 'PSS(1)
QUIT
DO SETZRO
+3 SET (CNT2,PSS(2))=0
FOR
SET PSS(2)=$ORDER(^TMP("PSS51P1",$JOB,51.11,PSS(2)))
IF 'PSS(2)
QUIT
DO SETWARD
SET CNT2=CNT2+1
+4 SET ^TMP($JOB,LIST,+PSSIEN,"WARD",0)=$SELECT(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
+5 SET (CNT3,PSS(3))=0
FOR
SET PSS(3)=$ORDER(^TMP("PSS51P1",$JOB,51.17,PSS(3)))
IF 'PSS(3)
QUIT
DO SETLOC
SET CNT3=CNT3+1
+6 SET ^TMP($JOB,LIST,+PSSIEN,"HOSP",0)=$SELECT(CNT3>0:CNT3,1:"-1^NO DATA FOUND")
+7 QUIT
+8 ;
WARD ;
+1 IF +$GET(PSSIEN2)>0
IF +$GET(PSSIEN)>0
DO GETS^DIQ(51.11,+PSSIEN2_","_+PSSIEN,".01;1","IE","^TMP($J,""PSS51P1""")
Begin DoDot:1
+2 DO GETS^DIQ(51.1,+PSSIEN,".01","IE","^TMP($J,""PSS51P1""")
SET PSS(1)=0
FOR
SET PSS(1)=$ORDER(^TMP($JOB,"PSS51P1",51.1,PSS(1)))
IF 'PSS(1)
QUIT
Begin DoDot:2
+3 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(^TMP($JOB,"PSS51P1",51.1,PSS(1),.01,"I"))
+4 SET ^TMP($JOB,LIST,"B",$GET(^TMP($JOB,"PSS51P1",51.1,PSS(1),.01,"E")),+PSS(1))=""
End DoDot:2
+5 SET PSS(1)=+PSSIEN
SET PSS(2)=0
FOR
SET PSS(2)=$ORDER(^TMP($JOB,"PSS51P1",51.11,PSS(2)))
IF 'PSS(2)
QUIT
DO SETWARD^PSS51P1B
SET CNT=CNT+1
+6 SET ^TMP($JOB,LIST,+PSSIEN,"WARD",0)=$SELECT(CNT>0:CNT,1:"-1^NO DATA FOUND FOR PSSIEN2 #"_PSSIEN2)
+7 SET ^TMP($JOB,LIST,0)=$SELECT($GET(^TMP($JOB,LIST,+PSSIEN,.01))]"":1,1:"-1^NO DATA FOUND")
End DoDot:1
+8 IF +$GET(PSSIEN)>0
IF +$GET(PSSIEN2)'>0
NEW PSSIEN3
SET PSSIEN3=$$FIND1^DIC(51.1,"","A","`"_PSSIEN,,,"")
Begin DoDot:1
+9 IF +PSSIEN3'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+10 SET ^TMP($JOB,LIST,0)=1
+11 DO GETS^DIQ(51.1,+PSSIEN3,".01;3*","IE","^TMP($J,""PSS51P1""")
SET PSS(1)=0
Begin DoDot:2
+12 FOR
SET PSS(1)=$ORDER(^TMP($JOB,"PSS51P1",51.1,PSS(1)))
IF 'PSS(1)
QUIT
SET ^TMP($JOB,LIST,+PSS(1),.01)=^TMP($JOB,"PSS51P1",51.1,PSS(1),.01,"I")
Begin DoDot:3
+13 SET ^TMP($JOB,LIST,"B",$GET(^TMP($JOB,"PSS51P1",51.1,PSS(1),.01,"E")),+PSS(1))=""
SET PSS(2)=0
+14 FOR
SET PSS(2)=$ORDER(^TMP($JOB,"PSS51P1",51.11,PSS(2)))
IF 'PSS(2)
QUIT
DO SETWARD^PSS51P1B
SET CNT=CNT+1
End DoDot:3
+15 SET ^TMP($JOB,LIST,+PSSIEN3,"WARD",0)=$SELECT(CNT>0:CNT,1:"-1^NO DATA FOUND")
End DoDot:2
End DoDot:1
+16 IF +$GET(PSSIEN)'>0
IF $GET(PSSFT)]""
Begin DoDot:1
+17 IF PSSFT["??"
DO LOOP^PSS51P1B(2)
QUIT
+18 DO FIND^DIC(51.1,,"@;.01","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)
+21 IF +$GET(PSSIEN2)'>0
NEW PSSXX
SET PSSXX=0
FOR
SET PSSXX=$ORDER(^TMP("DILIST",$JOB,PSSXX))
IF 'PSSXX
QUIT
Begin DoDot:2
+22 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
KILL ^TMP($JOB,"PSS51P1")
DO GETS^DIQ(51.1,+PSSIEN,".01;3*","IE","^TMP($J,""PSS51P1""")
SET (PSS(1),CNT)=0
Begin DoDot:3
+23 FOR
SET PSS(1)=$ORDER(^TMP($JOB,"PSS51P1",51.1,PSS(1)))
IF 'PSS(1)
QUIT
Begin DoDot:4
+24 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(^TMP($JOB,"PSS51P1",51.1,PSS(1),.01,"I"))
+25 SET ^TMP($JOB,LIST,"B",$GET(^TMP($JOB,"PSS51P1",51.1,PSS(1),.01,"E")),+PSS(1))=""
SET (PSS(2),CNT)=0
Begin DoDot:5
+26 FOR
SET PSS(2)=$ORDER(^TMP($JOB,"PSS51P1",51.11,PSS(2)))
IF 'PSS(2)
QUIT
DO SETWARD^PSS51P1B
SET CNT=CNT+1
+27 SET ^TMP($JOB,LIST,+PSS(1),"WARD",0)=$SELECT(CNT>0:CNT,1:"-1^NO DATA FOUND")
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+28 IF +$GET(PSSIEN2)>0
NEW PSSXX
SET PSSXX=0
FOR
SET PSSXX=$ORDER(^TMP("DILIST",$JOB,PSSXX))
IF 'PSSXX
QUIT
Begin DoDot:2
+29 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
KILL ^TMP($JOB,"PSS51P1")
DO GETS^DIQ(51.1,+PSSIEN,".01","IE","^TMP($J,""PSS51P1""")
+30 SET PSS(3)=0
FOR
SET PSS(3)=$ORDER(^TMP($JOB,"PSS51P1",51.1,PSS(3)))
IF 'PSS(3)
QUIT
Begin DoDot:3
+31 SET ^TMP($JOB,LIST,+PSS(3),.01)=$GET(^TMP($JOB,"PSS51P1",51.1,PSS(3),.01,"I"))
+32 SET ^TMP($JOB,LIST,"B",$GET(^TMP($JOB,"PSS51P1",51.1,PSS(3),.01,"E")),+PSS(3))=""
+33 DO GETS^DIQ(51.11,+PSSIEN2_","_+PSSIEN,".01;1","IE","^TMP($J,""PSS51P1""")
+34 SET PSS(1)=+PSSIEN
SET (PSS(2),CNT)=0
FOR
SET PSS(2)=$ORDER(^TMP($JOB,"PSS51P1",51.11,PSS(2)))
IF 'PSS(2)
QUIT
DO SETWARD^PSS51P1B
SET CNT=CNT+1
+35 SET ^TMP($JOB,LIST,+PSSIEN,"WARD",0)=$SELECT(CNT>0:CNT,1:"-1^NO DATA FOUND FOR PSSIEN2 #"_PSSIEN2)
End DoDot:3
End DoDot:2
End DoDot:1
+36 KILL ^TMP("DILIST",$JOB),^TMP($JOB,"PSS51P1")
+37 QUIT
