PSS51P1A ;BIR/LDT - API FOR INFORMATION FROM FILE 51.1 CONT.; 5 Sep 03
;;1.0;PHARMACY DATA MANAGEMENT;**85,91,118**;9/30/97;Build 8
;
HOSP ;
K ^TMP($J,LIST)
I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
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
.D GETS^DIQ(51.1,+PSSIEN2,".01;7*","IE","^TMP($J,""PSS51P1""") S (PSS(1),CNT)=0
.S PSSIEN=+PSSIEN2 F S PSS(1)=$O(^TMP($J,"PSS51P1",51.17,PSS(1))) Q:'PSS(1) D SETLOC^PSS51P1B S CNT=CNT+1
.S ^TMP($J,LIST,+PSSIEN,"HOSP",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
.S PSS(2)=0 F S PSS(2)=$O(^TMP($J,"PSS51P1",51.1,PSS(2))) Q:'PSS(2) D
..S ^TMP($J,LIST,+PSS(2),.01)=$G(^TMP($J,"PSS51P1",51.1,PSS(2),.01,"I"))
..S ^TMP($J,LIST,"B",$G(^TMP($J,"PSS51P1",51.1,PSS(2),.01,"E")),+PSS(2))=""
I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
.I PSSFT["??" D LOOP^PSS51P1B(3) 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) 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;7*","IE","^TMP($J,""PSS51P1""") S (PSS(1),CNT)=0 D
...F S PSS(1)=$O(^TMP($J,"PSS51P1",51.17,PSS(1))) Q:'PSS(1) D SETLOC^PSS51P1B S CNT=CNT+1
...S ^TMP($J,LIST,+PSSIEN,"HOSP",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
...S PSS(2)=0 F S PSS(2)=$O(^TMP($J,"PSS51P1",51.1,PSS(2))) Q:'PSS(2) D
....S ^TMP($J,LIST,+PSS(2),.01)=$G(^TMP($J,"PSS51P1",51.1,PSS(2),.01,"I"))
....S ^TMP($J,LIST,"B",$G(^TMP($J,"PSS51P1",51.1,PSS(2),.01,"E")),+PSS(2))=""
K ^TMP("DILIST",$J),^TMP($J,"PSS51P1")
Q
;
SCRFREQ ;
I (SCR("S")="")&(PSSFREQ'="") D
.S SCR("S")="I ($P($G(^PS(51.1,+Y,0)),""^"",3)'>PSSFREQ)&($P($G(^PS(51.1,+Y,0)),""^"",3)'="""")" Q
I ((SCR("S")'="")&(PSSFREQ'="")) D
.S SCR("S")=SCR("S")_"&($P($G(^PS(51.1,+Y,0)),""^"",3)'>PSSFREQ)&($P($G(^PS(51.1,+Y,0)),""^"",3)'="""")" Q
Q
;
AP ;
K ^TMP($J,LIST)
S SCR("S")=""
S SCR("S")=$S($G(PSSTYP)]"":"I ($P($G(^PS(51.1,+Y,0)),""^"",5)[PSSTYP)",1:"")
D SCRFREQ
I $G(PSSPP)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
I $G(PSSPP)]"",$G(PSSFT)="" D LIST^DIC(51.1,"","@;.01;1;2;2.5;4;5IE;8","P",,,,"AP"_PSSPP,SCR("S"),,) D
.I +^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)
..S ^TMP($J,LIST,+PSSIEN,.01)=$P($G(^TMP("DILIST",$J,PSSXX,0)),"^",2)
..S ^TMP($J,LIST,"AP"_PSSPP,$P($G(^TMP("DILIST",$J,PSSXX,0)),"^",2),+$G(^TMP("DILIST",$J,PSSXX,0)))=""
..S ^TMP($J,LIST,+PSSIEN,1)=$P($G(^TMP("DILIST",$J,PSSXX,0)),"^",3)
..S ^TMP($J,LIST,+PSSIEN,2)=$P($G(^TMP("DILIST",$J,PSSXX,0)),"^",4)
..S ^TMP($J,LIST,+PSSIEN,2.5)=$P($G(^TMP("DILIST",$J,PSSXX,0)),"^",5)
..S ^TMP($J,LIST,+PSSIEN,4)=$P($G(^TMP("DILIST",$J,PSSXX,0)),"^",6)
..S ^TMP($J,LIST,+PSSIEN,5)=$S($P($G(^TMP("DILIST",$J,PSSXX,0)),"^",7)="":"",1:$P($G(^TMP("DILIST",$J,PSSXX,0)),"^",7)_"^"_$P($G(^TMP("DILIST",$J,PSSXX,0)),"^",8))
..S ^TMP($J,LIST,+PSSIEN,8)=$P($G(^TMP("DILIST",$J,PSSXX,0)),"^",9)
..D HOSPLOC(LIST,+PSSIEN)
..I +$G(PSSWDIEN)'>0 K ^TMP($J,"PSS51P1") D GETS^DIQ(51.1,+PSSIEN,".01;3*","IE","^TMP($J,""PSS51P1""") D
...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")
..I +$G(PSSWDIEN)>0 K ^TMP($J,"PSS51P1") D GETS^DIQ(51.1,+PSSIEN,".01;3*","IE","^TMP($J,""PSS51P1""") D
...I +$D(^TMP($J,"PSS51P1",51.11))'>0 S ^TMP($J,LIST,+PSSIEN,"WARD",0)=-1_"^"_"NO DATA FOUND" Q
...S (PSS(2),CNT)=0 F S PSS(2)=$O(^TMP($J,"PSS51P1",51.11,PSS(2))) Q:'PSS(2) D
....I PSSWDIEN=$P($G(^TMP($J,"PSS51P1",51.11,PSS(2),.01,"I")),"^") D SETWRD2^PSS51P1B Q
....S ^TMP($J,LIST,+PSSIEN,"WARD",0)="-1^NO DATA FOUND FOR PSSWDIEN #"_PSSWDIEN
I $G(PSSPP)]"",$G(PSSFT)]"" D
.I PSSFT["??" D LOOP^PSS51P1B(5) Q
.D FIND^DIC(51.1,,"@;.01;1;2;2.5;4;5IE;8",,PSSFT,,"AP"_PSSPP,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,2,PSSXX)) Q:'PSSXX D
..S PSSIEN=+^TMP("DILIST",$J,2,PSSXX)
..S ^TMP($J,LIST,+PSSIEN,.01)=$G(^TMP("DILIST",$J,"ID",PSSXX,.01))
..S ^TMP($J,LIST,"AP"_PSSPP,$G(^TMP("DILIST",$J,"ID",PSSXX,.01)),+PSSIEN)=""
..S ^TMP($J,LIST,+PSSIEN,1)=$G(^TMP("DILIST",$J,"ID",PSSXX,1))
..S ^TMP($J,LIST,+PSSIEN,2)=$G(^TMP("DILIST",$J,"ID",PSSXX,2))
..S ^TMP($J,LIST,+PSSIEN,2.5)=$G(^TMP("DILIST",$J,"ID",PSSXX,2.5))
..S ^TMP($J,LIST,+PSSIEN,4)=$G(^TMP("DILIST",$J,"ID",PSSXX,4))
..S ^TMP($J,LIST,+PSSIEN,5)=$S($G(^TMP("DILIST",$J,"ID",PSSXX,5,"I"))="":"",1:$G(^TMP("DILIST",$J,"ID",PSSXX,5,"I"))_"^"_$G(^TMP("DILIST",$J,"ID",PSSXX,5,"E")))
..S ^TMP($J,LIST,+PSSIEN,8)=$G(^TMP("DILIST",$J,"ID",PSSXX,8))
..D HOSPLOC(LIST,+PSSIEN)
..I +$G(PSSWDIEN)'>0 K ^TMP($J,"PSS51P1") D GETS^DIQ(51.1,+PSSIEN,".01;3*","IE","^TMP($J,""PSS51P1""") D
...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")
..I +$G(PSSWDIEN)>0 K ^TMP($J,"PSS51P1") D GETS^DIQ(51.1,+PSSIEN,".01;3*","IE","^TMP($J,""PSS51P1""") D
...I +$D(^TMP($J,"PSS51P1",51.11))'>0 S ^TMP($J,LIST,+PSSIEN,"WARD",0)=-1_"^"_"NO DATA FOUND" Q
...S (PSS(2),CNT)=0 F S PSS(2)=$O(^TMP($J,"PSS51P1",51.11,PSS(2))) Q:'PSS(2) D
....I PSSWDIEN=$P($G(^TMP($J,"PSS51P1",51.11,PSS(2),.01,"I")),"^") D SETWRD2^PSS51P1B Q
....S ^TMP($J,LIST,+PSSIEN,"WARD",0)="-1^NO DATA FOUND FOR PSSWDIEN #"_PSSWDIEN
K ^TMP("DILIST",$J),^TMP($J,"PSS51P1")
Q
;
HOSPLOC(LIST,PSSIEN) ;
N PSSCNT S PSSCNT=0
N PSSHOSP D GETS^DIQ(51.1,+PSSIEN,"7*","IE","PSSHOSP")
N PSSTIM S PSSTIM=0 F S PSSTIM=$O(PSSHOSP(51.17,PSSTIM)) Q:'PSSTIM D
.S ^TMP($J,LIST,+PSSIEN,"HOSPITAL LOCATION",+PSSTIM,.01)=PSSHOSP(51.17,PSSTIM,.01,"I")_U_PSSHOSP(51.17,PSSTIM,.01,"E")
.S ^TMP($J,LIST,+PSSIEN,"HOSPITAL LOCATION",+PSSTIM,1)=$S(PSSHOSP(51.17,PSSTIM,1,"I")="":"",1:PSSHOSP(51.17,PSSTIM,1,"I"))
.S PSSCNT=PSSCNT+1
S ^TMP($J,LIST,+PSSIEN,"HOSPITAL LOCATION",0)=$S(PSSCNT>0:PSSCNT,1:"-1^NO DATA FOUND")
Q
;
IX ;
N CNT
K ^TMP($J,LIST)
I $G(PSSPP)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
I $G(PSSFT)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
I $G(PSSPP)]"",$G(PSSFT)]"" D
.I PSSFT["??" D LOOP^PSS51P1B(6) Q
.D FIND^DIC(51.1,,"@;.01","QP",PSSFT,,"AP"_PSSPP,,,"")
.I +$G(^TMP("DILIST",$J,0))'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
.I +^TMP("DILIST",$J,0)>0 N PSSXX S (PSSXX,CNT)=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0)
..K PSS51P1 D GETS^DIQ(51.1,+PSSIEN,".01;1;2;2.5;4;5;6;8;8.1","IE","PSS51P1")
..N PSSXX S PSSXX=0 F S PSSXX=$O(PSS51P1(51.1,PSSXX)) Q:'PSSXX D S CNT=CNT+1
...S ^TMP($J,LIST,+PSSXX,.01)=$G(PSS51P1(51.1,PSSXX,.01,"E"))
...S ^TMP($J,LIST,"AP"_PSSPP,$G(PSS51P1(51.1,PSSXX,.01,"E")),+PSSXX)=""
...S ^TMP($J,LIST,+PSSXX,1)=$G(PSS51P1(51.1,PSSXX,1,"E"))
...S ^TMP($J,LIST,+PSSXX,2)=$G(PSS51P1(51.1,PSSXX,2,"E"))
...S ^TMP($J,LIST,+PSSXX,2.5)=$G(PSS51P1(51.1,PSSXX,2.5,"E"))
...S ^TMP($J,LIST,+PSSXX,4)=$G(PSS51P1(51.1,PSSXX,4,"E"))
...S ^TMP($J,LIST,+PSSXX,5)=$S($G(PSS51P1(51.1,PSSXX,5,"I"))]"":$G(PSS51P1(51.1,PSSXX,5,"I"))_"^"_$G(PSS51P1(51.1,PSSXX,5,"E")),1:"")
...S ^TMP($J,LIST,+PSSXX,6)=$G(PSS51P1(51.1,PSSXX,6,"E"))
...S ^TMP($J,LIST,+PSSXX,8)=$G(PSS51P1(51.1,PSSXX,8,"E"))
...S ^TMP($J,LIST,+PSSXX,8.1)=$G(PSS51P1(51.1,PSSXX,8.1,"E"))
..S ^TMP($J,LIST,0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
K PSS51P1
K ^TMP("DILIST",$J)
Q
;
IEN ;
I $G(PSSFT)]"" D
.I PSSFT["??" D LOOP^PSS51P1B(4) Q
.D FIND^DIC(51.1,,"@;.01;1","QP",PSSFT,,"B",,,"PSS51P1")
.I +PSS51P1("DILIST",0)=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
.I +PSS51P1("DILIST",0)>0 S ^TMP($J,LIST,0)=+PSS51P1("DILIST",0) N PSSXX S PSSXX=0 F S PSSXX=$O(PSS51P1("DILIST",PSSXX)) Q:'PSSXX D
..S ^TMP($J,LIST,+$G(PSS51P1("DILIST",PSSXX,0)),.01)=$P($G(PSS51P1("DILIST",PSSXX,0)),"^",2)
..S ^TMP($J,LIST,+$G(PSS51P1("DILIST",PSSXX,0)),1)=$P($G(PSS51P1("DILIST",PSSXX,0)),"^",3)
..S ^TMP($J,LIST,"B",$P($G(PSS51P1("DILIST",PSSXX,0)),"^",2),+$G(PSS51P1("DILIST",PSSXX,0)))=""
K ^TMP("DILIST",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS51P1A 8670 printed Dec 13, 2024@02:30:06 Page 2
PSS51P1A ;BIR/LDT - API FOR INFORMATION FROM FILE 51.1 CONT.; 5 Sep 03
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**85,91,118**;9/30/97;Build 8
+2 ;
HOSP ;
+1 KILL ^TMP($JOB,LIST)
+2 IF +$GET(PSSIEN)'>0
IF ($GET(PSSFT)']"")
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+3 IF +$GET(PSSIEN)>0
NEW PSSIEN2
SET PSSIEN2=$$FIND1^DIC(51.1,"","A","`"_PSSIEN,,,"")
Begin DoDot:1
+4 IF +PSSIEN2'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+5 DO GETS^DIQ(51.1,+PSSIEN2,".01;7*","IE","^TMP($J,""PSS51P1""")
SET (PSS(1),CNT)=0
+6 SET PSSIEN=+PSSIEN2
FOR
SET PSS(1)=$ORDER(^TMP($JOB,"PSS51P1",51.17,PSS(1)))
if 'PSS(1)
QUIT
DO SETLOC^PSS51P1B
SET CNT=CNT+1
+7 SET ^TMP($JOB,LIST,+PSSIEN,"HOSP",0)=$SELECT(CNT>0:CNT,1:"-1^NO DATA FOUND")
+8 SET PSS(2)=0
FOR
SET PSS(2)=$ORDER(^TMP($JOB,"PSS51P1",51.1,PSS(2)))
if 'PSS(2)
QUIT
Begin DoDot:2
+9 SET ^TMP($JOB,LIST,+PSS(2),.01)=$GET(^TMP($JOB,"PSS51P1",51.1,PSS(2),.01,"I"))
+10 SET ^TMP($JOB,LIST,"B",$GET(^TMP($JOB,"PSS51P1",51.1,PSS(2),.01,"E")),+PSS(2))=""
End DoDot:2
End DoDot:1
+11 IF +$GET(PSSIEN)'>0
IF $GET(PSSFT)]""
Begin DoDot:1
+12 IF PSSFT["??"
DO LOOP^PSS51P1B(3)
QUIT
+13 DO FIND^DIC(51.1,,"@;.01","QP",PSSFT,,"B",,,"")
+14 IF +$GET(^TMP("DILIST",$JOB,0))=0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+15 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
+16 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
KILL ^TMP($JOB,"PSS51P1")
DO GETS^DIQ(51.1,+PSSIEN,".01;7*","IE","^TMP($J,""PSS51P1""")
SET (PSS(1),CNT)=0
Begin DoDot:3
+17 FOR
SET PSS(1)=$ORDER(^TMP($JOB,"PSS51P1",51.17,PSS(1)))
if 'PSS(1)
QUIT
DO SETLOC^PSS51P1B
SET CNT=CNT+1
+18 SET ^TMP($JOB,LIST,+PSSIEN,"HOSP",0)=$SELECT(CNT>0:CNT,1:"-1^NO DATA FOUND")
+19 SET PSS(2)=0
FOR
SET PSS(2)=$ORDER(^TMP($JOB,"PSS51P1",51.1,PSS(2)))
if 'PSS(2)
QUIT
Begin DoDot:4
+20 SET ^TMP($JOB,LIST,+PSS(2),.01)=$GET(^TMP($JOB,"PSS51P1",51.1,PSS(2),.01,"I"))
+21 SET ^TMP($JOB,LIST,"B",$GET(^TMP($JOB,"PSS51P1",51.1,PSS(2),.01,"E")),+PSS(2))=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+22 KILL ^TMP("DILIST",$JOB),^TMP($JOB,"PSS51P1")
+23 QUIT
+24 ;
SCRFREQ ;
+1 IF (SCR("S")="")&(PSSFREQ'="")
Begin DoDot:1
+2 SET SCR("S")="I ($P($G(^PS(51.1,+Y,0)),""^"",3)'>PSSFREQ)&($P($G(^PS(51.1,+Y,0)),""^"",3)'="""")"
QUIT
End DoDot:1
+3 IF ((SCR("S")'="")&(PSSFREQ'=""))
Begin DoDot:1
+4 SET SCR("S")=SCR("S")_"&($P($G(^PS(51.1,+Y,0)),""^"",3)'>PSSFREQ)&($P($G(^PS(51.1,+Y,0)),""^"",3)'="""")"
QUIT
End DoDot:1
+5 QUIT
+6 ;
AP ;
+1 KILL ^TMP($JOB,LIST)
+2 SET SCR("S")=""
+3 SET SCR("S")=$SELECT($GET(PSSTYP)]"":"I ($P($G(^PS(51.1,+Y,0)),""^"",5)[PSSTYP)",1:"")
+4 DO SCRFREQ
+5 IF $GET(PSSPP)']""
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+6 IF $GET(PSSPP)]""
IF $GET(PSSFT)=""
DO LIST^DIC(51.1,"","@;.01;1;2;2.5;4;5IE;8","P",,,,"AP"_PSSPP,SCR("S"),,)
Begin DoDot:1
+7 IF +^TMP("DILIST",$JOB,0)'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+8 IF +^TMP("DILIST",$JOB,0)>0
SET ^TMP($JOB,LIST,0)=+^TMP("DILIST",$JOB,0)
+9 NEW PSSXX
SET PSSXX=0
FOR
SET PSSXX=$ORDER(^TMP("DILIST",$JOB,PSSXX))
if 'PSSXX
QUIT
Begin DoDot:2
+10 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
+11 SET ^TMP($JOB,LIST,+PSSIEN,.01)=$PIECE($GET(^TMP("DILIST",$JOB,PSSXX,0)),"^",2)
+12 SET ^TMP($JOB,LIST,"AP"_PSSPP,$PIECE($GET(^TMP("DILIST",$JOB,PSSXX,0)),"^",2),+$GET(^TMP("DILIST",$JOB,PSSXX,0)))=""
+13 SET ^TMP($JOB,LIST,+PSSIEN,1)=$PIECE($GET(^TMP("DILIST",$JOB,PSSXX,0)),"^",3)
+14 SET ^TMP($JOB,LIST,+PSSIEN,2)=$PIECE($GET(^TMP("DILIST",$JOB,PSSXX,0)),"^",4)
+15 SET ^TMP($JOB,LIST,+PSSIEN,2.5)=$PIECE($GET(^TMP("DILIST",$JOB,PSSXX,0)),"^",5)
+16 SET ^TMP($JOB,LIST,+PSSIEN,4)=$PIECE($GET(^TMP("DILIST",$JOB,PSSXX,0)),"^",6)
+17 SET ^TMP($JOB,LIST,+PSSIEN,5)=$SELECT($PIECE($GET(^TMP("DILIST",$JOB,PSSXX,0)),"^",7)="":"",1:$PIECE($GET(^TMP("DILIST",$JOB,PSSXX,0)),"^",7)_"^"_$PIECE($GET(^TMP("DILIST",$JOB,PSSXX,0)),"^",8))
+18 SET ^TMP($JOB,LIST,+PSSIEN,8)=$PIECE($GET(^TMP("DILIST",$JOB,PSSXX,0)),"^",9)
+19 DO HOSPLOC(LIST,+PSSIEN)
+20 IF +$GET(PSSWDIEN)'>0
KILL ^TMP($JOB,"PSS51P1")
DO GETS^DIQ(51.1,+PSSIEN,".01;3*","IE","^TMP($J,""PSS51P1""")
Begin DoDot:3
+21 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
+22 SET ^TMP($JOB,LIST,+PSSIEN,"WARD",0)=$SELECT(CNT>0:CNT,1:-1_"^"_"NO DATA FOUND")
End DoDot:3
+23 IF +$GET(PSSWDIEN)>0
KILL ^TMP($JOB,"PSS51P1")
DO GETS^DIQ(51.1,+PSSIEN,".01;3*","IE","^TMP($J,""PSS51P1""")
Begin DoDot:3
+24 IF +$DATA(^TMP($JOB,"PSS51P1",51.11))'>0
SET ^TMP($JOB,LIST,+PSSIEN,"WARD",0)=-1_"^"_"NO DATA FOUND"
QUIT
+25 SET (PSS(2),CNT)=0
FOR
SET PSS(2)=$ORDER(^TMP($JOB,"PSS51P1",51.11,PSS(2)))
if 'PSS(2)
QUIT
Begin DoDot:4
+26 IF PSSWDIEN=$PIECE($GET(^TMP($JOB,"PSS51P1",51.11,PSS(2),.01,"I")),"^")
DO SETWRD2^PSS51P1B
QUIT
+27 SET ^TMP($JOB,LIST,+PSSIEN,"WARD",0)="-1^NO DATA FOUND FOR PSSWDIEN #"_PSSWDIEN
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+28 IF $GET(PSSPP)]""
IF $GET(PSSFT)]""
Begin DoDot:1
+29 IF PSSFT["??"
DO LOOP^PSS51P1B(5)
QUIT
+30 DO FIND^DIC(51.1,,"@;.01;1;2;2.5;4;5IE;8",,PSSFT,,"AP"_PSSPP,SCR("S"),,"")
+31 IF +$GET(^TMP("DILIST",$JOB,0))'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+32 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,2,PSSXX))
if 'PSSXX
QUIT
Begin DoDot:2
+33 SET PSSIEN=+^TMP("DILIST",$JOB,2,PSSXX)
+34 SET ^TMP($JOB,LIST,+PSSIEN,.01)=$GET(^TMP("DILIST",$JOB,"ID",PSSXX,.01))
+35 SET ^TMP($JOB,LIST,"AP"_PSSPP,$GET(^TMP("DILIST",$JOB,"ID",PSSXX,.01)),+PSSIEN)=""
+36 SET ^TMP($JOB,LIST,+PSSIEN,1)=$GET(^TMP("DILIST",$JOB,"ID",PSSXX,1))
+37 SET ^TMP($JOB,LIST,+PSSIEN,2)=$GET(^TMP("DILIST",$JOB,"ID",PSSXX,2))
+38 SET ^TMP($JOB,LIST,+PSSIEN,2.5)=$GET(^TMP("DILIST",$JOB,"ID",PSSXX,2.5))
+39 SET ^TMP($JOB,LIST,+PSSIEN,4)=$GET(^TMP("DILIST",$JOB,"ID",PSSXX,4))
+40 SET ^TMP($JOB,LIST,+PSSIEN,5)=$SELECT($GET(^TMP("DILIST",$JOB,"ID",PSSXX,5,"I"))="":"",1:$GET(^TMP("DILIST",$JOB,"ID",PSSXX,5,"I"))_"^"_$GET(^TMP("DILIST",$JOB,"ID",PSSXX,5,"E")))
+41 SET ^TMP($JOB,LIST,+PSSIEN,8)=$GET(^TMP("DILIST",$JOB,"ID",PSSXX,8))
+42 DO HOSPLOC(LIST,+PSSIEN)
+43 IF +$GET(PSSWDIEN)'>0
KILL ^TMP($JOB,"PSS51P1")
DO GETS^DIQ(51.1,+PSSIEN,".01;3*","IE","^TMP($J,""PSS51P1""")
Begin DoDot:3
+44 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
+45 SET ^TMP($JOB,LIST,+PSSIEN,"WARD",0)=$SELECT(CNT>0:CNT,1:-1_"^"_"NO DATA FOUND")
End DoDot:3
+46 IF +$GET(PSSWDIEN)>0
KILL ^TMP($JOB,"PSS51P1")
DO GETS^DIQ(51.1,+PSSIEN,".01;3*","IE","^TMP($J,""PSS51P1""")
Begin DoDot:3
+47 IF +$DATA(^TMP($JOB,"PSS51P1",51.11))'>0
SET ^TMP($JOB,LIST,+PSSIEN,"WARD",0)=-1_"^"_"NO DATA FOUND"
QUIT
+48 SET (PSS(2),CNT)=0
FOR
SET PSS(2)=$ORDER(^TMP($JOB,"PSS51P1",51.11,PSS(2)))
if 'PSS(2)
QUIT
Begin DoDot:4
+49 IF PSSWDIEN=$PIECE($GET(^TMP($JOB,"PSS51P1",51.11,PSS(2),.01,"I")),"^")
DO SETWRD2^PSS51P1B
QUIT
+50 SET ^TMP($JOB,LIST,+PSSIEN,"WARD",0)="-1^NO DATA FOUND FOR PSSWDIEN #"_PSSWDIEN
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+51 KILL ^TMP("DILIST",$JOB),^TMP($JOB,"PSS51P1")
+52 QUIT
+53 ;
HOSPLOC(LIST,PSSIEN) ;
+1 NEW PSSCNT
SET PSSCNT=0
+2 NEW PSSHOSP
DO GETS^DIQ(51.1,+PSSIEN,"7*","IE","PSSHOSP")
+3 NEW PSSTIM
SET PSSTIM=0
FOR
SET PSSTIM=$ORDER(PSSHOSP(51.17,PSSTIM))
if 'PSSTIM
QUIT
Begin DoDot:1
+4 SET ^TMP($JOB,LIST,+PSSIEN,"HOSPITAL LOCATION",+PSSTIM,.01)=PSSHOSP(51.17,PSSTIM,.01,"I")_U_PSSHOSP(51.17,PSSTIM,.01,"E")
+5 SET ^TMP($JOB,LIST,+PSSIEN,"HOSPITAL LOCATION",+PSSTIM,1)=$SELECT(PSSHOSP(51.17,PSSTIM,1,"I")="":"",1:PSSHOSP(51.17,PSSTIM,1,"I"))
+6 SET PSSCNT=PSSCNT+1
End DoDot:1
+7 SET ^TMP($JOB,LIST,+PSSIEN,"HOSPITAL LOCATION",0)=$SELECT(PSSCNT>0:PSSCNT,1:"-1^NO DATA FOUND")
+8 QUIT
+9 ;
IX ;
+1 NEW CNT
+2 KILL ^TMP($JOB,LIST)
+3 IF $GET(PSSPP)']""
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+4 IF $GET(PSSFT)']""
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+5 IF $GET(PSSPP)]""
IF $GET(PSSFT)]""
Begin DoDot:1
+6 IF PSSFT["??"
DO LOOP^PSS51P1B(6)
QUIT
+7 DO FIND^DIC(51.1,,"@;.01","QP",PSSFT,,"AP"_PSSPP,,,"")
+8 IF +$GET(^TMP("DILIST",$JOB,0))'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+9 IF +^TMP("DILIST",$JOB,0)>0
NEW PSSXX
SET (PSSXX,CNT)=0
FOR
SET PSSXX=$ORDER(^TMP("DILIST",$JOB,PSSXX))
if 'PSSXX
QUIT
Begin DoDot:2
+10 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
+11 KILL PSS51P1
DO GETS^DIQ(51.1,+PSSIEN,".01;1;2;2.5;4;5;6;8;8.1","IE","PSS51P1")
+12 NEW PSSXX
SET PSSXX=0
FOR
SET PSSXX=$ORDER(PSS51P1(51.1,PSSXX))
if 'PSSXX
QUIT
Begin DoDot:3
+13 SET ^TMP($JOB,LIST,+PSSXX,.01)=$GET(PSS51P1(51.1,PSSXX,.01,"E"))
+14 SET ^TMP($JOB,LIST,"AP"_PSSPP,$GET(PSS51P1(51.1,PSSXX,.01,"E")),+PSSXX)=""
+15 SET ^TMP($JOB,LIST,+PSSXX,1)=$GET(PSS51P1(51.1,PSSXX,1,"E"))
+16 SET ^TMP($JOB,LIST,+PSSXX,2)=$GET(PSS51P1(51.1,PSSXX,2,"E"))
+17 SET ^TMP($JOB,LIST,+PSSXX,2.5)=$GET(PSS51P1(51.1,PSSXX,2.5,"E"))
+18 SET ^TMP($JOB,LIST,+PSSXX,4)=$GET(PSS51P1(51.1,PSSXX,4,"E"))
+19 SET ^TMP($JOB,LIST,+PSSXX,5)=$SELECT($GET(PSS51P1(51.1,PSSXX,5,"I"))]"":$GET(PSS51P1(51.1,PSSXX,5,"I"))_"^"_$GET(PSS51P1(51.1,PSSXX,5,"E")),1:"")
+20 SET ^TMP($JOB,LIST,+PSSXX,6)=$GET(PSS51P1(51.1,PSSXX,6,"E"))
+21 SET ^TMP($JOB,LIST,+PSSXX,8)=$GET(PSS51P1(51.1,PSSXX,8,"E"))
+22 SET ^TMP($JOB,LIST,+PSSXX,8.1)=$GET(PSS51P1(51.1,PSSXX,8.1,"E"))
End DoDot:3
SET CNT=CNT+1
+23 SET ^TMP($JOB,LIST,0)=$SELECT(CNT>0:CNT,1:"-1^NO DATA FOUND")
End DoDot:2
End DoDot:1
+24 KILL PSS51P1
+25 KILL ^TMP("DILIST",$JOB)
+26 QUIT
+27 ;
IEN ;
+1 IF $GET(PSSFT)]""
Begin DoDot:1
+2 IF PSSFT["??"
DO LOOP^PSS51P1B(4)
QUIT
+3 DO FIND^DIC(51.1,,"@;.01;1","QP",PSSFT,,"B",,,"PSS51P1")
+4 IF +PSS51P1("DILIST",0)=0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+5 IF +PSS51P1("DILIST",0)>0
SET ^TMP($JOB,LIST,0)=+PSS51P1("DILIST",0)
NEW PSSXX
SET PSSXX=0
FOR
SET PSSXX=$ORDER(PSS51P1("DILIST",PSSXX))
if 'PSSXX
QUIT
Begin DoDot:2
+6 SET ^TMP($JOB,LIST,+$GET(PSS51P1("DILIST",PSSXX,0)),.01)=$PIECE($GET(PSS51P1("DILIST",PSSXX,0)),"^",2)
+7 SET ^TMP($JOB,LIST,+$GET(PSS51P1("DILIST",PSSXX,0)),1)=$PIECE($GET(PSS51P1("DILIST",PSSXX,0)),"^",3)
+8 SET ^TMP($JOB,LIST,"B",$PIECE($GET(PSS51P1("DILIST",PSSXX,0)),"^",2),+$GET(PSS51P1("DILIST",PSSXX,0)))=""
End DoDot:2
End DoDot:1
+9 KILL ^TMP("DILIST",$JOB)
+10 QUIT
