PSS52P6A.m

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSS52P6A   8284     printed  Feb 18, 2025@23:56:14                                                                                                                                                                                                    Page 2

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)