- PSS50P7A ;BIR/LDT - API FOR INFORMATION FROM FILE 50.7; 5 Sep 03
- ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
- ;
- LOOKUP ;
- N PSSSCRN,PSSLUPAR,PSSLUPP,PSSLKIEN,PSSCT507,PSSXSUB
- S SCR("S")=$S($G(PSSS)]"":PSSS,1:"")
- S PSSCT507=0
- I PSSFT["??" D LOOP^PSS50P7A(5) Q
- S PSSXSUB="" D SETXSUB
- K ^TMP("DILIST",$J),^TMP($J,"PSSLDONE")
- S PSSSCRN=$G(SCR("S")) S:$G(PSSD)="" PSSD="B" D PARSE^PSS50F(PSSD) I '$O(PSSLUPAR(0)) S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- S PSSLUPP=0 F S PSSLUPP=$O(PSSLUPAR(PSSLUPP)) Q:'PSSLUPP D
- .S SCR("S")=$G(PSSSCRN)
- .D FIND^DIC(50.7,,"@;.01;.02IE;.04IE","QPB"_$S($P(PSSLUPAR(PSSLUPP),"^",2):"X",1:""),PSSFT,,PSSLUPAR(PSSLUPP),SCR("S"),,"")
- .I +$G(^TMP("DILIST",$J,0))'>0 Q
- .S PSS(2)=0
- .F S PSS(2)=$O(^TMP("DILIST",$J,PSS(2))) Q:'PSS(2) D
- ..S PSSLKIEN=$P($G(^TMP("DILIST",$J,PSS(2),0)),"^") I '$D(^TMP($J,"PSSLDONE",PSSLKIEN)) S ^TMP($J,"PSSLDONE",PSSLKIEN)="" D
- ...S PSSCT507=PSSCT507+1
- ...S ^TMP($J,LIST,+^TMP("DILIST",$J,PSS(2),0),.01)=$P(^TMP("DILIST",$J,PSS(2),0),"^",2)
- ...S ^TMP($J,LIST,$S($G(PSSXSUB)'="":$G(PSSXSUB),1:"B"),$P(^TMP("DILIST",$J,PSS(2),0),"^",2),+^TMP("DILIST",$J,PSS(2),0))=""
- ...S ^TMP($J,LIST,+^TMP("DILIST",$J,PSS(2),0),.02)=$S($P($G(^TMP("DILIST",$J,PSS(2),0)),"^",3)]"":$P(^TMP("DILIST",$J,PSS(2),0),"^",3,4),1:"")
- ...S ^TMP($J,LIST,+^TMP("DILIST",$J,PSS(2),0),.04)=$S($P($G(^TMP("DILIST",$J,PSS(2),0)),"^",5)]"":$P(^TMP("DILIST",$J,PSS(2),0),"^",5,6),1:"")
- S ^TMP($J,LIST,0)=$S(PSSCT507>0:PSSCT507,1:"-1^NO DATA FOUND")
- K ^TMP("DILIST",$J),^TMP($J,"PSSLDONE")
- Q
- SETZRO ;
- S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS50P7(50.7,PSS(1),.01,"I"))
- S ^TMP($J,LIST,"B",$G(PSS50P7(50.7,PSS(1),.01,"I")),+PSS(1))=""
- S ^TMP($J,LIST,+PSS(1),.02)=$S($G(PSS50P7(50.7,PSS(1),.02,"I"))="":"",1:PSS50P7(50.7,PSS(1),.02,"I")_"^"_PSS50P7(50.7,PSS(1),.02,"E"))
- S ^TMP($J,LIST,+PSS(1),.03)=$S($G(PSS50P7(50.7,PSS(1),.03,"I"))="":"",1:PSS50P7(50.7,PSS(1),.03,"I")_"^"_PSS50P7(50.7,PSS(1),.03,"E"))
- S ^TMP($J,LIST,+PSS(1),.04)=$S($G(PSS50P7(50.7,PSS(1),.04,"I"))="":"",1:PSS50P7(50.7,PSS(1),.04,"I")_"^"_PSS50P7(50.7,PSS(1),.04,"E"))
- S ^TMP($J,LIST,+PSS(1),.05)=$G(PSS50P7(50.7,PSS(1),.05,"I"))
- S ^TMP($J,LIST,+PSS(1),.06)=$S($G(PSS50P7(50.7,PSS(1),.06,"I"))="":"",1:PSS50P7(50.7,PSS(1),.06,"I")_"^"_PSS50P7(50.7,PSS(1),.06,"E"))
- S ^TMP($J,LIST,+PSS(1),.07)=$S($G(PSS50P7(50.7,PSS(1),.07,"I"))="":"",1:PSS50P7(50.7,PSS(1),.07,"I")_"^"_PSS50P7(50.7,PSS(1),.07,"E"))
- S ^TMP($J,LIST,+PSS(1),.08)=$G(PSS50P7(50.7,PSS(1),.08,"I"))
- S ^TMP($J,LIST,+PSS(1),.09)=$S($G(PSS50P7(50.7,PSS(1),.09,"I"))="":"",1:PSS50P7(50.7,PSS(1),.09,"I")_"^"_PSS50P7(50.7,PSS(1),.09,"E"))
- S ^TMP($J,LIST,+PSS(1),8)=$S($G(PSS50P7(50.7,PSS(1),8,"I"))="":"",1:PSS50P7(50.7,PSS(1),8,"I")_"^"_PSS50P7(50.7,PSS(1),8,"E"))
- S ^TMP($J,LIST,+PSS(1),5)=$S($G(PSS50P7(50.7,PSS(1),5,"I"))="":"",1:PSS50P7(50.7,PSS(1),5,"I")_"^"_PSS50P7(50.7,PSS(1),5,"E"))
- Q
- ;
- SETZR2 ;
- S ^TMP($J,LIST,+PSS(2),.01)=$G(PSS50P7(50.7,PSS(2),.01,"I"))
- S ^TMP($J,LIST,"B",$G(PSS50P7(50.7,PSS(2),.01,"I")),+PSS(2))=""
- S ^TMP($J,LIST,+PSS(2),.02)=$S($G(PSS50P7(50.7,PSS(2),.02,"I"))="":"",1:PSS50P7(50.7,PSS(2),.02,"I")_"^"_PSS50P7(50.7,PSS(2),.02,"E"))
- Q
- ;
- SETSYN ;
- S ^TMP($J,LIST,+PSSIEN,"SYN",+PSS(1),.01)=$G(PSS50P7(50.72,PSS(1),.01,"I"))
- Q
- ;
- SETPTI ;
- S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS50P7(50.7,PSS(1),.01,"I"))
- S ^TMP($J,LIST,"B",$G(PSS50P7(50.7,PSS(1),.01,"I")),+PSS(1))=""
- S ^TMP($J,LIST,+PSS(1),.02)=$S($G(PSS50P7(50.7,PSS(1),.02,"I"))="":"",1:PSS50P7(50.7,PSS(1),.02,"I")_"^"_PSS50P7(50.7,PSS(1),.02,"E"))
- S ^TMP($J,LIST,+PSS(1),7)=$G(PSS50P7(50.7,PSS(1),7,"I"))
- S ^TMP($J,LIST,+PSS(1),7.1)=$G(PSS50P7(50.7,PSS(1),7.1,"I"))
- Q
- ;
- LOOP(PSS) ;
- N CNT,PSSIEN S CNT=0
- S PSSIEN=0 F S PSSIEN=$O(^PS(50.7,PSSIEN)) Q:'PSSIEN D
- .S ND=$P($G(^PS(50.7,+PSSIEN,0)),U,4) I ND=""!ND>$G(PSSFL) D @(PSS)
- S ^TMP($J,LIST,0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
- Q
- ;
- 1 ;
- K PSS50P7 D GETS^DIQ(50.7,+PSSIEN,".01;.02;.03;.04;.05;.06;.07;.08;.09;8;5","IE","PSS50P7") S PSS(1)=0
- F S PSS(1)=$O(PSS50P7(50.7,PSS(1))) Q:'PSS(1) D SETZRO^PSS50P7A S CNT=CNT+1
- Q
- ;
- 2 ;
- N CNT2 S CNT2=0
- K PSS50P7 D GETS^DIQ(50.7,+PSSIEN,".01;.02;2*","IE","PSS50P7") S PSS(1)=0
- F S PSS(1)=$O(PSS50P7(50.72,PSS(1))) Q:'PSS(1) D SETSYN^PSS50P7A S CNT2=CNT2+1
- S PSS(2)=0 F S PSS(2)=$O(PSS50P7(50.7,PSS(2))) Q:'PSS(2) D SETZR2^PSS50P7A S CNT=CNT+1
- S ^TMP($J,LIST,+PSSIEN,"SYN",0)=$S(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
- Q
- ;
- 3 ;
- K PSS50P7 D GETS^DIQ(50.7,+PSSIEN,".01;.02;7;7.1","IE","PSS50P7") S PSS(1)=0
- F S PSS(1)=$O(PSS50P7(50.7,PSS(1))) Q:'PSS(1) D SETPTI^PSS50P7A S CNT=CNT+1
- Q
- ;
- 4 ;
- K PSS50P7 D GETS^DIQ(50.7,+PSSIEN,".01;.02","IE","PSS50P7") S PSS(2)=0
- F S PSS(2)=$O(PSS50P7(50.7,PSS(2))) Q:'PSS(2) D SETZR2^PSS50P7A S CNT=CNT+1
- Q
- ;
- 5 ;
- D FIND^DIC(50.7,,"@;.01;.02IE;.04IE","QP","`"_+PSSIEN,,"B",SCR("S"),,"")
- S CNT=CNT+1,^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) S PSS(2)=0 D
- .F S PSS(2)=$O(^TMP("DILIST",$J,PSS(2))) Q:'PSS(2) D
- ..S ^TMP($J,LIST,+^TMP("DILIST",$J,PSS(2),0),.01)=$P(^TMP("DILIST",$J,PSS(2),0),"^",2)
- ..S ^TMP($J,LIST,"B",$P(^TMP("DILIST",$J,PSS(2),0),"^",2),+^TMP("DILIST",$J,PSS(2),0))=""
- ..S ^TMP($J,LIST,+^TMP("DILIST",$J,PSS(2),0),.02)=$S($P($G(^TMP("DILIST",$J,PSS(2),0)),"^",3)]"":$P(^TMP("DILIST",$J,PSS(2),0),"^",3,4),1:"")
- ..S ^TMP($J,LIST,+^TMP("DILIST",$J,PSS(2),0),.04)=$S($P($G(^TMP("DILIST",$J,PSS(2),0)),"^",5)]"":$P(^TMP("DILIST",$J,PSS(2),0),"^",5,6),1:"")
- K ^TMP("DILIST",$J)
- Q
- SETXSUB ;
- Q:$G(PSSD)=""
- N PSSLSX,PSSLSXCT,PSSLCNT,PSSDSUB
- S PSSLSXCT=0
- F PSSLSX=1:1:$L(PSSD) I $E(PSSD,PSSLSX)="^" S PSSLSXCT=PSSLSXCT+1
- S PSSLSXCT=PSSLSXCT+1
- S PSSLCNT=0 F PSSLSX=1:1:PSSLSXCT S PSSDSUB=$P(PSSD,"^",PSSLSX) Q:PSSLCNT>1 S PSSXSUB=$S(PSSDSUB'="":PSSDSUB,PSSXSUB'="":PSSXSUB,1:"") S:PSSDSUB'="" PSSLCNT=PSSLCNT+1
- I PSSLCNT>1 S PSSXSUB=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS50P7A 5885 printed Feb 18, 2025@23:56:02 Page 2
- PSS50P7A ;BIR/LDT - API FOR INFORMATION FROM FILE 50.7; 5 Sep 03
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
- +2 ;
- LOOKUP ;
- +1 NEW PSSSCRN,PSSLUPAR,PSSLUPP,PSSLKIEN,PSSCT507,PSSXSUB
- +2 SET SCR("S")=$SELECT($GET(PSSS)]"":PSSS,1:"")
- +3 SET PSSCT507=0
- +4 IF PSSFT["??"
- DO LOOP^PSS50P7A(5)
- QUIT
- +5 SET PSSXSUB=""
- DO SETXSUB
- +6 KILL ^TMP("DILIST",$JOB),^TMP($JOB,"PSSLDONE")
- +7 SET PSSSCRN=$GET(SCR("S"))
- if $GET(PSSD)=""
- SET PSSD="B"
- DO PARSE^PSS50F(PSSD)
- IF '$ORDER(PSSLUPAR(0))
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +8 SET PSSLUPP=0
- FOR
- SET PSSLUPP=$ORDER(PSSLUPAR(PSSLUPP))
- if 'PSSLUPP
- QUIT
- Begin DoDot:1
- +9 SET SCR("S")=$GET(PSSSCRN)
- +10 DO FIND^DIC(50.7,,"@;.01;.02IE;.04IE","QPB"_$SELECT($PIECE(PSSLUPAR(PSSLUPP),"^",2):"X",1:""),PSSFT,,PSSLUPAR(PSSLUPP),SCR("S"),,"")
- +11 IF +$GET(^TMP("DILIST",$JOB,0))'>0
- QUIT
- +12 SET PSS(2)=0
- +13 FOR
- SET PSS(2)=$ORDER(^TMP("DILIST",$JOB,PSS(2)))
- if 'PSS(2)
- QUIT
- Begin DoDot:2
- +14 SET PSSLKIEN=$PIECE($GET(^TMP("DILIST",$JOB,PSS(2),0)),"^")
- IF '$DATA(^TMP($JOB,"PSSLDONE",PSSLKIEN))
- SET ^TMP($JOB,"PSSLDONE",PSSLKIEN)=""
- Begin DoDot:3
- +15 SET PSSCT507=PSSCT507+1
- +16 SET ^TMP($JOB,LIST,+^TMP("DILIST",$JOB,PSS(2),0),.01)=$PIECE(^TMP("DILIST",$JOB,PSS(2),0),"^",2)
- +17 SET ^TMP($JOB,LIST,$SELECT($GET(PSSXSUB)'="":$GET(PSSXSUB),1:"B"),$PIECE(^TMP("DILIST",$JOB,PSS(2),0),"^",2),+^TMP("DILIST",$JOB,PSS(2),0))=""
- +18 SET ^TMP($JOB,LIST,+^TMP("DILIST",$JOB,PSS(2),0),.02)=$SELECT($PIECE($GET(^TMP("DILIST",$JOB,PSS(2),0)),"^",3)]"":$PIECE(^TMP("DILIST",$JOB,PSS(2),0),"^",3,4),1:"")
- +19 SET ^TMP($JOB,LIST,+^TMP("DILIST",$JOB,PSS(2),0),.04)=$SELECT($PIECE($GET(^TMP("DILIST",$JOB,PSS(2),0)),"^",5)]"":$PIECE(^TMP("DILIST",$JOB,PSS(2),0),"^",5,6),1:"")
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +20 SET ^TMP($JOB,LIST,0)=$SELECT(PSSCT507>0:PSSCT507,1:"-1^NO DATA FOUND")
- +21 KILL ^TMP("DILIST",$JOB),^TMP($JOB,"PSSLDONE")
- +22 QUIT
- SETZRO ;
- +1 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(PSS50P7(50.7,PSS(1),.01,"I"))
- +2 SET ^TMP($JOB,LIST,"B",$GET(PSS50P7(50.7,PSS(1),.01,"I")),+PSS(1))=""
- +3 SET ^TMP($JOB,LIST,+PSS(1),.02)=$SELECT($GET(PSS50P7(50.7,PSS(1),.02,"I"))="":"",1:PSS50P7(50.7,PSS(1),.02,"I")_"^"_PSS50P7(50.7,PSS(1),.02,"E"))
- +4 SET ^TMP($JOB,LIST,+PSS(1),.03)=$SELECT($GET(PSS50P7(50.7,PSS(1),.03,"I"))="":"",1:PSS50P7(50.7,PSS(1),.03,"I")_"^"_PSS50P7(50.7,PSS(1),.03,"E"))
- +5 SET ^TMP($JOB,LIST,+PSS(1),.04)=$SELECT($GET(PSS50P7(50.7,PSS(1),.04,"I"))="":"",1:PSS50P7(50.7,PSS(1),.04,"I")_"^"_PSS50P7(50.7,PSS(1),.04,"E"))
- +6 SET ^TMP($JOB,LIST,+PSS(1),.05)=$GET(PSS50P7(50.7,PSS(1),.05,"I"))
- +7 SET ^TMP($JOB,LIST,+PSS(1),.06)=$SELECT($GET(PSS50P7(50.7,PSS(1),.06,"I"))="":"",1:PSS50P7(50.7,PSS(1),.06,"I")_"^"_PSS50P7(50.7,PSS(1),.06,"E"))
- +8 SET ^TMP($JOB,LIST,+PSS(1),.07)=$SELECT($GET(PSS50P7(50.7,PSS(1),.07,"I"))="":"",1:PSS50P7(50.7,PSS(1),.07,"I")_"^"_PSS50P7(50.7,PSS(1),.07,"E"))
- +9 SET ^TMP($JOB,LIST,+PSS(1),.08)=$GET(PSS50P7(50.7,PSS(1),.08,"I"))
- +10 SET ^TMP($JOB,LIST,+PSS(1),.09)=$SELECT($GET(PSS50P7(50.7,PSS(1),.09,"I"))="":"",1:PSS50P7(50.7,PSS(1),.09,"I")_"^"_PSS50P7(50.7,PSS(1),.09,"E"))
- +11 SET ^TMP($JOB,LIST,+PSS(1),8)=$SELECT($GET(PSS50P7(50.7,PSS(1),8,"I"))="":"",1:PSS50P7(50.7,PSS(1),8,"I")_"^"_PSS50P7(50.7,PSS(1),8,"E"))
- +12 SET ^TMP($JOB,LIST,+PSS(1),5)=$SELECT($GET(PSS50P7(50.7,PSS(1),5,"I"))="":"",1:PSS50P7(50.7,PSS(1),5,"I")_"^"_PSS50P7(50.7,PSS(1),5,"E"))
- +13 QUIT
- +14 ;
- SETZR2 ;
- +1 SET ^TMP($JOB,LIST,+PSS(2),.01)=$GET(PSS50P7(50.7,PSS(2),.01,"I"))
- +2 SET ^TMP($JOB,LIST,"B",$GET(PSS50P7(50.7,PSS(2),.01,"I")),+PSS(2))=""
- +3 SET ^TMP($JOB,LIST,+PSS(2),.02)=$SELECT($GET(PSS50P7(50.7,PSS(2),.02,"I"))="":"",1:PSS50P7(50.7,PSS(2),.02,"I")_"^"_PSS50P7(50.7,PSS(2),.02,"E"))
- +4 QUIT
- +5 ;
- SETSYN ;
- +1 SET ^TMP($JOB,LIST,+PSSIEN,"SYN",+PSS(1),.01)=$GET(PSS50P7(50.72,PSS(1),.01,"I"))
- +2 QUIT
- +3 ;
- SETPTI ;
- +1 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(PSS50P7(50.7,PSS(1),.01,"I"))
- +2 SET ^TMP($JOB,LIST,"B",$GET(PSS50P7(50.7,PSS(1),.01,"I")),+PSS(1))=""
- +3 SET ^TMP($JOB,LIST,+PSS(1),.02)=$SELECT($GET(PSS50P7(50.7,PSS(1),.02,"I"))="":"",1:PSS50P7(50.7,PSS(1),.02,"I")_"^"_PSS50P7(50.7,PSS(1),.02,"E"))
- +4 SET ^TMP($JOB,LIST,+PSS(1),7)=$GET(PSS50P7(50.7,PSS(1),7,"I"))
- +5 SET ^TMP($JOB,LIST,+PSS(1),7.1)=$GET(PSS50P7(50.7,PSS(1),7.1,"I"))
- +6 QUIT
- +7 ;
- LOOP(PSS) ;
- +1 NEW CNT,PSSIEN
- SET CNT=0
- +2 SET PSSIEN=0
- FOR
- SET PSSIEN=$ORDER(^PS(50.7,PSSIEN))
- if 'PSSIEN
- QUIT
- Begin DoDot:1
- +3 SET ND=$PIECE($GET(^PS(50.7,+PSSIEN,0)),U,4)
- IF ND=""!ND>$GET(PSSFL)
- DO @(PSS)
- End DoDot:1
- +4 SET ^TMP($JOB,LIST,0)=$SELECT(CNT>0:CNT,1:"-1^NO DATA FOUND")
- +5 QUIT
- +6 ;
- 1 ;
- +1 KILL PSS50P7
- DO GETS^DIQ(50.7,+PSSIEN,".01;.02;.03;.04;.05;.06;.07;.08;.09;8;5","IE","PSS50P7")
- SET PSS(1)=0
- +2 FOR
- SET PSS(1)=$ORDER(PSS50P7(50.7,PSS(1)))
- if 'PSS(1)
- QUIT
- DO SETZRO^PSS50P7A
- SET CNT=CNT+1
- +3 QUIT
- +4 ;
- 2 ;
- +1 NEW CNT2
- SET CNT2=0
- +2 KILL PSS50P7
- DO GETS^DIQ(50.7,+PSSIEN,".01;.02;2*","IE","PSS50P7")
- SET PSS(1)=0
- +3 FOR
- SET PSS(1)=$ORDER(PSS50P7(50.72,PSS(1)))
- if 'PSS(1)
- QUIT
- DO SETSYN^PSS50P7A
- SET CNT2=CNT2+1
- +4 SET PSS(2)=0
- FOR
- SET PSS(2)=$ORDER(PSS50P7(50.7,PSS(2)))
- if 'PSS(2)
- QUIT
- DO SETZR2^PSS50P7A
- SET CNT=CNT+1
- +5 SET ^TMP($JOB,LIST,+PSSIEN,"SYN",0)=$SELECT(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
- +6 QUIT
- +7 ;
- 3 ;
- +1 KILL PSS50P7
- DO GETS^DIQ(50.7,+PSSIEN,".01;.02;7;7.1","IE","PSS50P7")
- SET PSS(1)=0
- +2 FOR
- SET PSS(1)=$ORDER(PSS50P7(50.7,PSS(1)))
- if 'PSS(1)
- QUIT
- DO SETPTI^PSS50P7A
- SET CNT=CNT+1
- +3 QUIT
- +4 ;
- 4 ;
- +1 KILL PSS50P7
- DO GETS^DIQ(50.7,+PSSIEN,".01;.02","IE","PSS50P7")
- SET PSS(2)=0
- +2 FOR
- SET PSS(2)=$ORDER(PSS50P7(50.7,PSS(2)))
- if 'PSS(2)
- QUIT
- DO SETZR2^PSS50P7A
- SET CNT=CNT+1
- +3 QUIT
- +4 ;
- 5 ;
- +1 DO FIND^DIC(50.7,,"@;.01;.02IE;.04IE","QP","`"_+PSSIEN,,"B",SCR("S"),,"")
- +2 SET CNT=CNT+1
- SET ^TMP($JOB,LIST,0)=+^TMP("DILIST",$JOB,0)
- SET PSS(2)=0
- Begin DoDot:1
- +3 FOR
- SET PSS(2)=$ORDER(^TMP("DILIST",$JOB,PSS(2)))
- if 'PSS(2)
- QUIT
- Begin DoDot:2
- +4 SET ^TMP($JOB,LIST,+^TMP("DILIST",$JOB,PSS(2),0),.01)=$PIECE(^TMP("DILIST",$JOB,PSS(2),0),"^",2)
- +5 SET ^TMP($JOB,LIST,"B",$PIECE(^TMP("DILIST",$JOB,PSS(2),0),"^",2),+^TMP("DILIST",$JOB,PSS(2),0))=""
- +6 SET ^TMP($JOB,LIST,+^TMP("DILIST",$JOB,PSS(2),0),.02)=$SELECT($PIECE($GET(^TMP("DILIST",$JOB,PSS(2),0)),"^",3)]"":$PIECE(^TMP("DILIST",$JOB,PSS(2),0),"^",3,4),1:"")
- +7 SET ^TMP($JOB,LIST,+^TMP("DILIST",$JOB,PSS(2),0),.04)=$SELECT($PIECE($GET(^TMP("DILIST",$JOB,PSS(2),0)),"^",5)]"":$PIECE(^TMP("DILIST",$JOB,PSS(2),0),"^",5,6),1:"")
- End DoDot:2
- End DoDot:1
- +8 KILL ^TMP("DILIST",$JOB)
- +9 QUIT
- SETXSUB ;
- +1 if $GET(PSSD)=""
- QUIT
- +2 NEW PSSLSX,PSSLSXCT,PSSLCNT,PSSDSUB
- +3 SET PSSLSXCT=0
- +4 FOR PSSLSX=1:1:$LENGTH(PSSD)
- IF $EXTRACT(PSSD,PSSLSX)="^"
- SET PSSLSXCT=PSSLSXCT+1
- +5 SET PSSLSXCT=PSSLSXCT+1
- +6 SET PSSLCNT=0
- FOR PSSLSX=1:1:PSSLSXCT
- SET PSSDSUB=$PIECE(PSSD,"^",PSSLSX)
- if PSSLCNT>1
- QUIT
- SET PSSXSUB=$SELECT(PSSDSUB'="":PSSDSUB,PSSXSUB'="":PSSXSUB,1:"")
- if PSSDSUB'=""
- SET PSSLCNT=PSSLCNT+1
- +7 IF PSSLCNT>1
- SET PSSXSUB=""
- +8 QUIT
