PSS52P6A ;BIR/LDT - SETS ARRAYS AND INACTIVE SCREEN CALLED FROM PSS52P6; 5 Sep 03
;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
;
;
;
SETSCRN ;Set Screen for inactive Additives
;Naked reference below refers to ^PS(52.6,+Y,"I")
S SCR("S")="S ND=$P($G(^(""I"")),U) I ND=""""!(ND>PSSFL)"
Q
;
SETZRO ;
S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS52P6(52.6,PSS(1),.01,"I"))
S ^TMP($J,LIST,"B",$G(PSS52P6(52.6,PSS(1),.01,"I")),+PSS(1))=""
S ^TMP($J,LIST,+PSS(1),1)=$S($G(PSS52P6(52.6,PSS(1),1,"I"))="":"",1:PSS52P6(52.6,PSS(1),1,"I")_"^"_PSS52P6(52.6,PSS(1),1,"E"))
S ^TMP($J,LIST,+PSS(1),2)=$S($G(PSS52P6(52.6,PSS(1),2,"I"))="":"",1:PSS52P6(52.6,PSS(1),2,"I")_"^"_PSS52P6(52.6,PSS(1),2,"E"))
S ^TMP($J,LIST,+PSS(1),3)=$G(PSS52P6(52.6,PSS(1),3,"I"))
S ^TMP($J,LIST,+PSS(1),4)=$G(PSS52P6(52.6,PSS(1),4,"I"))
S ^TMP($J,LIST,+PSS(1),5)=$G(PSS52P6(52.6,PSS(1),5,"I"))
S ^TMP($J,LIST,+PSS(1),7)=$G(PSS52P6(52.6,PSS(1),7,"I"))
S ^TMP($J,LIST,+PSS(1),14)=$G(PSS52P6(52.6,PSS(1),14,"I"))
S ^TMP($J,LIST,+PSS(1),13)=$G(PSS52P6(52.6,PSS(1),13,"I"))
S ^TMP($J,LIST,+PSS(1),15)=$S($G(PSS52P6(52.6,PSS(1),15,"I"))="":"",1:PSS52P6(52.6,PSS(1),15,"I")_"^"_PSS52P6(52.6,PSS(1),15,"E"))
S ^TMP($J,LIST,+PSS(1),17)=$S($G(PSS52P6(52.6,PSS(1),17,"I"))="":"",1:PSS52P6(52.6,PSS(1),17,"I")_"^"_PSS52P6(52.6,PSS(1),17,"E"))
S ^TMP($J,LIST,+PSS(1),12)=$S($G(PSS52P6(52.6,PSS(1),12,"I"))="":"",1:PSS52P6(52.6,PSS(1),12,"I")_"^"_PSS52P6(52.6,PSS(1),12,"E"))
Q
;
SETZRO2 ;
S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSS52P6",$J,52.6,PSS(1),.01,"I"))
S ^TMP($J,LIST,"B",$G(^TMP("PSS52P6",$J,52.6,PSS(1),.01,"I")),+PSS(1))=""
S ^TMP($J,LIST,+PSS(1),14)=$G(^TMP("PSS52P6",$J,52.6,PSS(1),14,"I"))
Q
;
SETQCD ;
S ^TMP($J,LIST,+PSSIEN,"QCODE",+PSS(1),.01)=$G(^TMP("PSS52P6",$J,52.61,PSS(1),.01,"I"))
S ^TMP($J,LIST,+PSSIEN,"QCODE",+PSS(1),1)=$G(^TMP("PSS52P6",$J,52.61,PSS(1),1,"I"))
S ^TMP($J,LIST,+PSSIEN,"QCODE",+PSS(1),2)=$G(^TMP("PSS52P6",$J,52.61,PSS(1),2,"I"))
S ^TMP($J,LIST,+PSSIEN,"QCODE",+PSS(1),3)=$G(^TMP("PSS52P6",$J,52.61,PSS(1),3,"I"))
S ^TMP($J,LIST,+PSSIEN,"QCODE",+PSS(1),4)=$G(^TMP("PSS52P6",$J,52.61,PSS(1),4,"I"))
S ^TMP($J,LIST,+PSSIEN,"QCODE",+PSS(1),5)=$G(^TMP("PSS52P6",$J,52.61,PSS(1),5,"I"))
S ^TMP($J,LIST,+PSSIEN,"QCODE",+PSS(1),6)=$S($G(^TMP("PSS52P6",$J,52.61,PSS(1),6,"I"))="":"",1:^TMP("PSS52P6",$J,52.61,PSS(1),6,"I")_"^"_^TMP("PSS52P6",$J,52.61,PSS(1),6,"E"))
S ^TMP($J,LIST,+PSSIEN,"QCODE",+PSS(1),7)=$S($G(^TMP("PSS52P6",$J,52.61,PSS(1),7,"I"))="":"",1:^TMP("PSS52P6",$J,52.61,PSS(1),7,"I")_"^"_^TMP("PSS52P6",$J,52.61,PSS(1),7,"E"))
Q
;
SETQCD2 ;
S ^TMP($J,LIST,+PSSIEN,"QCODE",+PSS(2),.01)=$G(^TMP("PSS52P6",$J,52.61,PSS(2),.01,"I"))
Q
;
SETLTS ;
S ^TMP($J,LIST,+PSSIEN,"ELYTES",+PSS(1),.01)=$S($G(^TMP("PSS52P6",$J,52.62,PSS(1),.01,"I"))="":"",1:^TMP("PSS52P6",$J,52.62,PSS(1),.01,"I")_"^"_^TMP("PSS52P6",$J,52.62,PSS(1),.01,"E"))
S ^TMP($J,LIST,+PSSIEN,"ELYTES",+PSS(1),1)=$G(^TMP("PSS52P6",$J,52.62,PSS(1),1,"I"))
Q
;
SETSYN ;
S ^TMP($J,LIST,+PSSIEN,"SYN",+PSS(1),.01)=$G(^TMP("PSS52P6",$J,52.63,PSS(1),.01,"I"))
Q
;
SETSYN2 ;
S ^TMP($J,LIST,+PSSIEN,"SYN",+PSS(3),.01)=$G(^TMP("PSS52P6",$J,52.63,PSS(3),.01,"I"))
Q
;
SETDRI ;
S ^TMP($J,LIST,+PSS(1),"DRGINF",+PSS(3),.01)=$G(^TMP("PSS52P6",$J,52.6,PSS(1),10,PSS(3)))
Q
;
SETIACT ;
S ^TMP($J,LIST,+PSS(1),12)=$S($G(PSS52P6(52.6,PSS(1),12,"I"))="":"",1:PSS52P6(52.6,PSS(1),12,"I")_"^"_PSS52P6(52.6,PSS(1),12,"E"))
Q
;
LOOP(PSSNUM) ;
N CNT S CNT=0
S PSS(2)=0 F S PSS(2)=$O(^PS(52.6,PSS(2))) Q:'PSS(2) D @(PSSNUM)
S ^TMP($J,LIST,0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
Q
;
1 ;Called from LOOP in response to "??" entered at ZERO^PSS52P6.
S PSSIEN=+PSS(2) K PSS52P6
S ND=$P($G(^PS(52.6,+PSSIEN,"I")),U) I ND=""!(ND>$G(PSSFL)) D GETS^DIQ(52.6,+PSSIEN,".01;1;2;3;4;5;7;12;13;14;15;17","IE","PSS52P6") S PSS(1)=0 D
.F S PSS(1)=$O(PSS52P6(52.6,PSS(1))) Q:'PSS(1) D SETZRO S CNT=CNT+1
Q
;
2 ;Called from LOOP in response to "??" entered at QCODE^PSS52P6.
N CNT2
S PSSIEN=+PSS(2) K ^TMP("PSS52P6",$J)
S ND=$P($G(^PS(52.6,+PSSIEN,"I")),U) I ND=""!(ND>$G(PSSFL)) D GETS^DIQ(52.6,+PSSIEN,".01;6*","IE","^TMP(""PSS52P6"",$J)") D
.S PSS(3)=0 F S PSS(3)=$O(^TMP("PSS52P6",$J,52.6,PSS(3))) Q:'PSS(3) D
..S ^TMP($J,LIST,+PSSIEN,.01)=$G(^TMP("PSS52P6",$J,52.6,PSS(3),.01,"I"))
..S ^TMP($J,LIST,"B",$G(^TMP("PSS52P6",$J,52.6,PSS(3),.01,"E")),+PSSIEN)="",CNT=CNT+1
.I '$D(^TMP("PSS52P6",$J,52.61)) S ^TMP($J,LIST,+PSSIEN,"QCODE",0)="-1^NO DATA FOUND"
.S (PSS(1),CNT2)=0 F S PSS(1)=$O(^TMP("PSS52P6",$J,52.61,PSS(1))) Q:'PSS(1) D SETQCD S CNT2=CNT2+1
.S ^TMP($J,LIST,+PSSIEN,"QCODE",0)=$S(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
Q
;
3 ;Called from LOOP in response to "??" entered at ELYTES^PSS52P6.
N CNT2
S PSSIEN=+PSS(2) K ^TMP("PSS52P6",$J)
S ND=$P($G(^PS(52.6,+PSSIEN,"I")),U) I ND=""!(ND>$G(PSSFL)) D GETS^DIQ(52.6,+PSSIEN,".01;8*","IE","^TMP(""PSS52P6"",$J)") D
.S PSS(3)=0 F S PSS(3)=$O(^TMP("PSS52P6",$J,52.6,PSS(3))) Q:'PSS(3) D
..S ^TMP($J,LIST,+PSSIEN,.01)=$G(^TMP("PSS52P6",$J,52.6,PSS(3),.01,"I"))
..S ^TMP($J,LIST,"B",$G(^TMP("PSS52P6",$J,52.6,PSS(3),.01,"E")),+PSSIEN)="",CNT=CNT+1
..S (PSS(1),CNT2)=0 F S PSS(1)=$O(^TMP("PSS52P6",$J,52.62,PSS(1))) Q:'PSS(1) D SETLTS S CNT2=CNT2+1
..S ^TMP($J,LIST,+PSSIEN,"ELYTES",0)=$S(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
Q
;
4 ;Called from LOOP in response to "??" entered at SYNONYM^PSS52P6.
S PSSIEN=+PSS(2) K ^TMP("PSS52P6",$J)
S ND=$P($G(^PS(52.6,+PSSIEN,"I")),U) I ND=""!(ND>$G(PSSFL)) D GETS^DIQ(52.6,+PSSIEN,".01;9*","IE","^TMP(""PSS52P6"",$J)") D
.N CNT2 S (PSS(1),CNT2)=0 F S PSS(1)=$O(^TMP("PSS52P6",$J,52.63,PSS(1))) Q:'PSS(1) D SETSYN S CNT2=CNT2+1
.S PSS(3)=0 F S PSS(3)=$O(^TMP("PSS52P6",$J,52.6,PSS(3))) Q:'PSS(3) D
..S ^TMP($J,LIST,+PSSIEN,.01)=$G(^TMP("PSS52P6",$J,52.6,PSS(3),.01,"I"))
..S ^TMP($J,LIST,"B",$G(^TMP("PSS52P6",$J,52.6,PSS(3),.01,"E")),+PSSIEN)="",CNT=CNT+1
.S ^TMP($J,LIST,+PSSIEN,"SYN",0)=$S(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
Q
;
5 ;Called from LOOP in response to "??" entered at DRGINFO^PSS52P6.
N CNT2
S PSSIEN=+PSS(2) K ^TMP("PSS52P6",$J)
S ND=$P($G(^PS(52.6,+PSSIEN,"I")),U) I ND=""!(ND>$G(PSSFL)) D GETS^DIQ(52.6,+PSSIEN,".01;10","E","^TMP(""PSS52P6"",$J)") D
.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)=$G(^TMP("PSS52P6",$J,52.6,PSS(1),.01,"E"))
..S ^TMP($J,LIST,"B",$G(^TMP("PSS52P6",$J,52.6,PSS(1),.01,"E")),+PSS(1))="",CNT=CNT+1
..S (PSS(3),CNT2)=0 F S PSS(3)=$O(^TMP("PSS52P6",$J,52.6,PSS(1),10,PSS(3))) Q:'PSS(3) D SETDRI^PSS52P6A S CNT2=CNT2+1
..S ^TMP($J,LIST,+PSSIEN,"DRGINF",0)=$S(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
Q
QCODE ;
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;6*","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.61,PSS(1))) Q:'PSS(1) D SETQCD^PSS52P6A S CNT=CNT+1
.S ^TMP($J,LIST,+PSSIEN,"QCODE",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
.I PSSFT["??" D LOOP^PSS52P6A(2) Q
.D FIND^DIC(52.6,,"@;.01;2","QP",PSSFT,,"B^C",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,"6*","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.61,PSS(1))) Q:'PSS(1) D SETQCD^PSS52P6A S CNT=CNT+1
..S ^TMP($J,LIST,+PSSIEN,"QCODE",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
K ^TMP("DILIST",$J),^TMP("PSS52P6",$J)
Q
PSS52P6A ;BIR/LDT - SETS ARRAYS AND INACTIVE SCREEN CALLED FROM PSS52P6; 5 Sep 03
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
+2 ;
+3 ;
+4 ;
SETSCRN ;Set Screen for inactive Additives
+1 ;Naked reference below refers to ^PS(52.6,+Y,"I")
+2 SET SCR("S")="S ND=$P($G(^(""I"")),U) I ND=""""!(ND>PSSFL)"
+3 QUIT
+4 ;
SETZRO ;
+1 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(PSS52P6(52.6,PSS(1),.01,"I"))
+2 SET ^TMP($JOB,LIST,"B",$GET(PSS52P6(52.6,PSS(1),.01,"I")),+PSS(1))=""
+3 SET ^TMP($JOB,LIST,+PSS(1),1)=$SELECT($GET(PSS52P6(52.6,PSS(1),1,"I"))="":"",1:PSS52P6(52.6,PSS(1),1,"I")_"^"_PSS52P6(52.6,PSS(1),1,"E"))
+4 SET ^TMP($JOB,LIST,+PSS(1),2)=$SELECT($GET(PSS52P6(52.6,PSS(1),2,"I"))="":"",1:PSS52P6(52.6,PSS(1),2,"I")_"^"_PSS52P6(52.6,PSS(1),2,"E"))
+5 SET ^TMP($JOB,LIST,+PSS(1),3)=$GET(PSS52P6(52.6,PSS(1),3,"I"))
+6 SET ^TMP($JOB,LIST,+PSS(1),4)=$GET(PSS52P6(52.6,PSS(1),4,"I"))
+7 SET ^TMP($JOB,LIST,+PSS(1),5)=$GET(PSS52P6(52.6,PSS(1),5,"I"))
+8 SET ^TMP($JOB,LIST,+PSS(1),7)=$GET(PSS52P6(52.6,PSS(1),7,"I"))
+9 SET ^TMP($JOB,LIST,+PSS(1),14)=$GET(PSS52P6(52.6,PSS(1),14,"I"))
+10 SET ^TMP($JOB,LIST,+PSS(1),13)=$GET(PSS52P6(52.6,PSS(1),13,"I"))
+11 SET ^TMP($JOB,LIST,+PSS(1),15)=$SELECT($GET(PSS52P6(52.6,PSS(1),15,"I"))="":"",1:PSS52P6(52.6,PSS(1),15,"I")_"^"_PSS52P6(52.6,PSS(1),15,"E"))
+12 SET ^TMP($JOB,LIST,+PSS(1),17)=$SELECT($GET(PSS52P6(52.6,PSS(1),17,"I"))="":"",1:PSS52P6(52.6,PSS(1),17,"I")_"^"_PSS52P6(52.6,PSS(1),17,"E"))
+13 SET ^TMP($JOB,LIST,+PSS(1),12)=$SELECT($GET(PSS52P6(52.6,PSS(1),12,"I"))="":"",1:PSS52P6(52.6,PSS(1),12,"I")_"^"_PSS52P6(52.6,PSS(1),12,"E"))
+14 QUIT
+15 ;
SETZRO2 ;
+1 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(^TMP("PSS52P6",$JOB,52.6,PSS(1),.01,"I"))
+2 SET ^TMP($JOB,LIST,"B",$GET(^TMP("PSS52P6",$JOB,52.6,PSS(1),.01,"I")),+PSS(1))=""
+3 SET ^TMP($JOB,LIST,+PSS(1),14)=$GET(^TMP("PSS52P6",$JOB,52.6,PSS(1),14,"I"))
+4 QUIT
+5 ;
SETQCD ;
+1 SET ^TMP($JOB,LIST,+PSSIEN,"QCODE",+PSS(1),.01)=$GET(^TMP("PSS52P6",$JOB,52.61,PSS(1),.01,"I"))
+2 SET ^TMP($JOB,LIST,+PSSIEN,"QCODE",+PSS(1),1)=$GET(^TMP("PSS52P6",$JOB,52.61,PSS(1),1,"I"))
+3 SET ^TMP($JOB,LIST,+PSSIEN,"QCODE",+PSS(1),2)=$GET(^TMP("PSS52P6",$JOB,52.61,PSS(1),2,"I"))
+4 SET ^TMP($JOB,LIST,+PSSIEN,"QCODE",+PSS(1),3)=$GET(^TMP("PSS52P6",$JOB,52.61,PSS(1),3,"I"))
+5 SET ^TMP($JOB,LIST,+PSSIEN,"QCODE",+PSS(1),4)=$GET(^TMP("PSS52P6",$JOB,52.61,PSS(1),4,"I"))
+6 SET ^TMP($JOB,LIST,+PSSIEN,"QCODE",+PSS(1),5)=$GET(^TMP("PSS52P6",$JOB,52.61,PSS(1),5,"I"))
+7 SET ^TMP($JOB,LIST,+PSSIEN,"QCODE",+PSS(1),6)=$SELECT($GET(^TMP("PSS52P6",$JOB,52.61,PSS(1),6,"I"))="":"",1:^TMP("PSS52P6",$JOB,52.61,PSS(1),6,"I")_"^"_^TMP("PSS52P6",$JOB,52.61,PSS(1),6,"E"))
+8 SET ^TMP($JOB,LIST,+PSSIEN,"QCODE",+PSS(1),7)=$SELECT($GET(^TMP("PSS52P6",$JOB,52.61,PSS(1),7,"I"))="":"",1:^TMP("PSS52P6",$JOB,52.61,PSS(1),7,"I")_"^"_^TMP("PSS52P6",$JOB,52.61,PSS(1),7,"E"))
+9 QUIT
+10 ;
SETQCD2 ;
+1 SET ^TMP($JOB,LIST,+PSSIEN,"QCODE",+PSS(2),.01)=$GET(^TMP("PSS52P6",$JOB,52.61,PSS(2),.01,"I"))
+2 QUIT
+3 ;
SETLTS ;
+1 SET ^TMP($JOB,LIST,+PSSIEN,"ELYTES",+PSS(1),.01)=$SELECT($GET(^TMP("PSS52P6",$JOB,52.62,PSS(1),.01,"I"))="":"",1:^TMP("PSS52P6",$JOB,52.62,PSS(1),.01,"I")_"^"_^TMP("PSS52P6",$JOB,52.62,PSS(1),.01,"E"))
+2 SET ^TMP($JOB,LIST,+PSSIEN,"ELYTES",+PSS(1),1)=$GET(^TMP("PSS52P6",$JOB,52.62,PSS(1),1,"I"))
+3 QUIT
+4 ;
SETSYN ;
+1 SET ^TMP($JOB,LIST,+PSSIEN,"SYN",+PSS(1),.01)=$GET(^TMP("PSS52P6",$JOB,52.63,PSS(1),.01,"I"))
+2 QUIT
+3 ;
SETSYN2 ;
+1 SET ^TMP($JOB,LIST,+PSSIEN,"SYN",+PSS(3),.01)=$GET(^TMP("PSS52P6",$JOB,52.63,PSS(3),.01,"I"))
+2 QUIT
+3 ;
SETDRI ;
+1 SET ^TMP($JOB,LIST,+PSS(1),"DRGINF",+PSS(3),.01)=$GET(^TMP("PSS52P6",$JOB,52.6,PSS(1),10,PSS(3)))
+2 QUIT
+3 ;
SETIACT ;
+1 SET ^TMP($JOB,LIST,+PSS(1),12)=$SELECT($GET(PSS52P6(52.6,PSS(1),12,"I"))="":"",1:PSS52P6(52.6,PSS(1),12,"I")_"^"_PSS52P6(52.6,PSS(1),12,"E"))
+2 QUIT
+3 ;
LOOP(PSSNUM) ;
+1 NEW CNT
SET CNT=0
+2 SET PSS(2)=0
FOR
SET PSS(2)=$ORDER(^PS(52.6,PSS(2)))
IF 'PSS(2)
QUIT
DO @(PSSNUM)
+3 SET ^TMP($JOB,LIST,0)=$SELECT(CNT>0:CNT,1:"-1^NO DATA FOUND")
+4 QUIT
+5 ;
1 ;Called from LOOP in response to "??" entered at ZERO^PSS52P6.
+1 SET PSSIEN=+PSS(2)
KILL PSS52P6
+2 SET ND=$PIECE($GET(^PS(52.6,+PSSIEN,"I")),U)
IF ND=""!(ND>$GET(PSSFL))
DO GETS^DIQ(52.6,+PSSIEN,".01;1;2;3;4;5;7;12;13;14;15;17","IE","PSS52P6")
SET PSS(1)=0
Begin DoDot:1
+3 FOR
SET PSS(1)=$ORDER(PSS52P6(52.6,PSS(1)))
IF 'PSS(1)
QUIT
DO SETZRO
SET CNT=CNT+1
End DoDot:1
+4 QUIT
+5 ;
2 ;Called from LOOP in response to "??" entered at QCODE^PSS52P6.
+1 NEW CNT2
+2 SET PSSIEN=+PSS(2)
KILL ^TMP("PSS52P6",$JOB)
+3 SET ND=$PIECE($GET(^PS(52.6,+PSSIEN,"I")),U)
IF ND=""!(ND>$GET(PSSFL))
DO GETS^DIQ(52.6,+PSSIEN,".01;6*","IE","^TMP(""PSS52P6"",$J)")
Begin DoDot:1
+4 SET PSS(3)=0
FOR
SET PSS(3)=$ORDER(^TMP("PSS52P6",$JOB,52.6,PSS(3)))
IF 'PSS(3)
QUIT
Begin DoDot:2
+5 SET ^TMP($JOB,LIST,+PSSIEN,.01)=$GET(^TMP("PSS52P6",$JOB,52.6,PSS(3),.01,"I"))
+6 SET ^TMP($JOB,LIST,"B",$GET(^TMP("PSS52P6",$JOB,52.6,PSS(3),.01,"E")),+PSSIEN)=""
SET CNT=CNT+1
End DoDot:2
+7 IF '$DATA(^TMP("PSS52P6",$JOB,52.61))
SET ^TMP($JOB,LIST,+PSSIEN,"QCODE",0)="-1^NO DATA FOUND"
+8 SET (PSS(1),CNT2)=0
FOR
SET PSS(1)=$ORDER(^TMP("PSS52P6",$JOB,52.61,PSS(1)))
IF 'PSS(1)
QUIT
DO SETQCD
SET CNT2=CNT2+1
+9 SET ^TMP($JOB,LIST,+PSSIEN,"QCODE",0)=$SELECT(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
End DoDot:1
+10 QUIT
+11 ;
3 ;Called from LOOP in response to "??" entered at ELYTES^PSS52P6.
+1 NEW CNT2
+2 SET PSSIEN=+PSS(2)
KILL ^TMP("PSS52P6",$JOB)
+3 SET ND=$PIECE($GET(^PS(52.6,+PSSIEN,"I")),U)
IF ND=""!(ND>$GET(PSSFL))
DO GETS^DIQ(52.6,+PSSIEN,".01;8*","IE","^TMP(""PSS52P6"",$J)")
Begin DoDot:1
+4 SET PSS(3)=0
FOR
SET PSS(3)=$ORDER(^TMP("PSS52P6",$JOB,52.6,PSS(3)))
IF 'PSS(3)
QUIT
Begin DoDot:2
+5 SET ^TMP($JOB,LIST,+PSSIEN,.01)=$GET(^TMP("PSS52P6",$JOB,52.6,PSS(3),.01,"I"))
+6 SET ^TMP($JOB,LIST,"B",$GET(^TMP("PSS52P6",$JOB,52.6,PSS(3),.01,"E")),+PSSIEN)=""
SET CNT=CNT+1
+7 SET (PSS(1),CNT2)=0
FOR
SET PSS(1)=$ORDER(^TMP("PSS52P6",$JOB,52.62,PSS(1)))
IF 'PSS(1)
QUIT
DO SETLTS
SET CNT2=CNT2+1
+8 SET ^TMP($JOB,LIST,+PSSIEN,"ELYTES",0)=$SELECT(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
4 ;Called from LOOP in response to "??" entered at SYNONYM^PSS52P6.
+1 SET PSSIEN=+PSS(2)
KILL ^TMP("PSS52P6",$JOB)
+2 SET ND=$PIECE($GET(^PS(52.6,+PSSIEN,"I")),U)
IF ND=""!(ND>$GET(PSSFL))
DO GETS^DIQ(52.6,+PSSIEN,".01;9*","IE","^TMP(""PSS52P6"",$J)")
Begin DoDot:1
+3 NEW CNT2
SET (PSS(1),CNT2)=0
FOR
SET PSS(1)=$ORDER(^TMP("PSS52P6",$JOB,52.63,PSS(1)))
IF 'PSS(1)
QUIT
DO SETSYN
SET CNT2=CNT2+1
+4 SET PSS(3)=0
FOR
SET PSS(3)=$ORDER(^TMP("PSS52P6",$JOB,52.6,PSS(3)))
IF 'PSS(3)
QUIT
Begin DoDot:2
+5 SET ^TMP($JOB,LIST,+PSSIEN,.01)=$GET(^TMP("PSS52P6",$JOB,52.6,PSS(3),.01,"I"))
+6 SET ^TMP($JOB,LIST,"B",$GET(^TMP("PSS52P6",$JOB,52.6,PSS(3),.01,"E")),+PSSIEN)=""
SET CNT=CNT+1
End DoDot:2
+7 SET ^TMP($JOB,LIST,+PSSIEN,"SYN",0)=$SELECT(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
End DoDot:1
+8 QUIT
+9 ;
5 ;Called from LOOP in response to "??" entered at DRGINFO^PSS52P6.
+1 NEW CNT2
+2 SET PSSIEN=+PSS(2)
KILL ^TMP("PSS52P6",$JOB)
+3 SET ND=$PIECE($GET(^PS(52.6,+PSSIEN,"I")),U)
IF ND=""!(ND>$GET(PSSFL))
DO GETS^DIQ(52.6,+PSSIEN,".01;10","E","^TMP(""PSS52P6"",$J)")
Begin DoDot:1
+4 SET PSS(1)=0
FOR
SET PSS(1)=$ORDER(^TMP("PSS52P6",$JOB,52.6,PSS(1)))
IF 'PSS(1)
QUIT
Begin DoDot:2
+5 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(^TMP("PSS52P6",$JOB,52.6,PSS(1),.01,"E"))
+6 SET ^TMP($JOB,LIST,"B",$GET(^TMP("PSS52P6",$JOB,52.6,PSS(1),.01,"E")),+PSS(1))=""
SET CNT=CNT+1
+7 SET (PSS(3),CNT2)=0
FOR
SET PSS(3)=$ORDER(^TMP("PSS52P6",$JOB,52.6,PSS(1),10,PSS(3)))
IF 'PSS(3)
QUIT
DO SETDRI^PSS52P6A
SET CNT2=CNT2+1
+8 SET ^TMP($JOB,LIST,+PSSIEN,"DRGINF",0)=$SELECT(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
End DoDot:2
End DoDot:1
+9 QUIT
QCODE ;
+1 SET SCR("S")=""
+2 IF +$GET(PSSFL)>0
NEW ND
DO SETSCRN^PSS52P6A
+3 IF +$GET(PSSIEN)>0
NEW PSSIEN2
SET PSSIEN2=$$FIND1^DIC(52.6,"","A","`"_PSSIEN,,SCR("S"),"")
Begin DoDot:1
+4 IF +PSSIEN2'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+5 SET ^TMP($JOB,LIST,0)=1
+6 DO GETS^DIQ(52.6,+PSSIEN2,".01;6*","IE","^TMP(""PSS52P6"",$J)")
SET PSS(1)=0
+7 FOR
SET PSS(1)=$ORDER(^TMP("PSS52P6",$JOB,52.6,PSS(1)))
IF 'PSS(1)
QUIT
Begin DoDot:2
+8 SET ^TMP($JOB,LIST,+PSSIEN2,.01)=^TMP("PSS52P6",$JOB,52.6,PSS(1),.01,"I")
+9 SET ^TMP($JOB,LIST,"B",^TMP("PSS52P6",$JOB,52.6,PSS(1),.01,"I"),+PSSIEN2)=""
End DoDot:2
+10 NEW CNT
SET (PSS(1),CNT)=0
FOR
SET PSS(1)=$ORDER(^TMP("PSS52P6",$JOB,52.61,PSS(1)))
IF 'PSS(1)
QUIT
DO SETQCD^PSS52P6A
SET CNT=CNT+1
+11 SET ^TMP($JOB,LIST,+PSSIEN,"QCODE",0)=$SELECT(CNT>0:CNT,1:"-1^NO DATA FOUND")
End DoDot:1
+12 IF +$GET(PSSIEN)'>0
IF $GET(PSSFT)]""
Begin DoDot:1
+13 IF PSSFT["??"
DO LOOP^PSS52P6A(2)
QUIT
+14 DO FIND^DIC(52.6,,"@;.01;2","QP",PSSFT,,"B^C",SCR("S"),,"")
+15 IF +$GET(^TMP("DILIST",$JOB,0))=0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+16 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
+17 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
KILL ^TMP("PSS52P6",$JOB)
DO GETS^DIQ(52.6,+PSSIEN,"6*","IE","^TMP(""PSS52P6"",$J)")
Begin DoDot:3
+18 SET ^TMP($JOB,LIST,+PSSIEN,.01)=$PIECE(^TMP("DILIST",$JOB,PSSXX,0),"^",2)
+19 SET ^TMP($JOB,LIST,"B",$PIECE(^TMP("DILIST",$JOB,PSSXX,0),"^",2),+PSSIEN)=""
End DoDot:3
+20 NEW CNT
SET (PSS(1),CNT)=0
FOR
SET PSS(1)=$ORDER(^TMP("PSS52P6",$JOB,52.61,PSS(1)))
IF 'PSS(1)
QUIT
DO SETQCD^PSS52P6A
SET CNT=CNT+1
+21 SET ^TMP($JOB,LIST,+PSSIEN,"QCODE",0)=$SELECT(CNT>0:CNT,1:"-1^NO DATA FOUND")
End DoDot:2
End DoDot:1
+22 KILL ^TMP("DILIST",$JOB),^TMP("PSS52P6",$JOB)
+23 QUIT
