- 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 Feb 18, 2025@23:56:08 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