Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSS51P1A

PSS51P1A.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. HOSP ;
  1. K ^TMP($J,LIST)
  1. I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1. I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(51.1,"","A","`"_PSSIEN,,,"") D
  1. .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1. .D GETS^DIQ(51.1,+PSSIEN2,".01;7*","IE","^TMP($J,""PSS51P1""") S (PSS(1),CNT)=0
  1. .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
  1. .S ^TMP($J,LIST,+PSSIEN,"HOSP",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
  1. .S PSS(2)=0 F S PSS(2)=$O(^TMP($J,"PSS51P1",51.1,PSS(2))) Q:'PSS(2) D
  1. ..S ^TMP($J,LIST,+PSS(2),.01)=$G(^TMP($J,"PSS51P1",51.1,PSS(2),.01,"I"))
  1. ..S ^TMP($J,LIST,"B",$G(^TMP($J,"PSS51P1",51.1,PSS(2),.01,"E")),+PSS(2))=""
  1. I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
  1. .I PSSFT["??" D LOOP^PSS51P1B(3) Q
  1. .D FIND^DIC(51.1,,"@;.01","QP",PSSFT,,"B",,,"")
  1. .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1. .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
  1. ..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
  1. ...F S PSS(1)=$O(^TMP($J,"PSS51P1",51.17,PSS(1))) Q:'PSS(1) D SETLOC^PSS51P1B S CNT=CNT+1
  1. ...S ^TMP($J,LIST,+PSSIEN,"HOSP",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
  1. ...S PSS(2)=0 F S PSS(2)=$O(^TMP($J,"PSS51P1",51.1,PSS(2))) Q:'PSS(2) D
  1. ....S ^TMP($J,LIST,+PSS(2),.01)=$G(^TMP($J,"PSS51P1",51.1,PSS(2),.01,"I"))
  1. ....S ^TMP($J,LIST,"B",$G(^TMP($J,"PSS51P1",51.1,PSS(2),.01,"E")),+PSS(2))=""
  1. K ^TMP("DILIST",$J),^TMP($J,"PSS51P1")
  1. Q
  1. ;
  1. SCRFREQ ;
  1. I (SCR("S")="")&(PSSFREQ'="") D
  1. .S SCR("S")="I ($P($G(^PS(51.1,+Y,0)),""^"",3)'>PSSFREQ)&($P($G(^PS(51.1,+Y,0)),""^"",3)'="""")" Q
  1. I ((SCR("S")'="")&(PSSFREQ'="")) D
  1. .S SCR("S")=SCR("S")_"&($P($G(^PS(51.1,+Y,0)),""^"",3)'>PSSFREQ)&($P($G(^PS(51.1,+Y,0)),""^"",3)'="""")" Q
  1. Q
  1. ;
  1. AP ;
  1. K ^TMP($J,LIST)
  1. S SCR("S")=""
  1. S SCR("S")=$S($G(PSSTYP)]"":"I ($P($G(^PS(51.1,+Y,0)),""^"",5)[PSSTYP)",1:"")
  1. D SCRFREQ
  1. I $G(PSSPP)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1. I $G(PSSPP)]"",$G(PSSFT)="" D LIST^DIC(51.1,"","@;.01;1;2;2.5;4;5IE;8","P",,,,"AP"_PSSPP,SCR("S"),,) D
  1. .I +^TMP("DILIST",$J,0)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1. .I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0)
  1. .N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
  1. ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0)
  1. ..S ^TMP($J,LIST,+PSSIEN,.01)=$P($G(^TMP("DILIST",$J,PSSXX,0)),"^",2)
  1. ..S ^TMP($J,LIST,"AP"_PSSPP,$P($G(^TMP("DILIST",$J,PSSXX,0)),"^",2),+$G(^TMP("DILIST",$J,PSSXX,0)))=""
  1. ..S ^TMP($J,LIST,+PSSIEN,1)=$P($G(^TMP("DILIST",$J,PSSXX,0)),"^",3)
  1. ..S ^TMP($J,LIST,+PSSIEN,2)=$P($G(^TMP("DILIST",$J,PSSXX,0)),"^",4)
  1. ..S ^TMP($J,LIST,+PSSIEN,2.5)=$P($G(^TMP("DILIST",$J,PSSXX,0)),"^",5)
  1. ..S ^TMP($J,LIST,+PSSIEN,4)=$P($G(^TMP("DILIST",$J,PSSXX,0)),"^",6)
  1. ..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))
  1. ..S ^TMP($J,LIST,+PSSIEN,8)=$P($G(^TMP("DILIST",$J,PSSXX,0)),"^",9)
  1. ..D HOSPLOC(LIST,+PSSIEN)
  1. ..I +$G(PSSWDIEN)'>0 K ^TMP($J,"PSS51P1") D GETS^DIQ(51.1,+PSSIEN,".01;3*","IE","^TMP($J,""PSS51P1""") D
  1. ...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
  1. ...S ^TMP($J,LIST,+PSSIEN,"WARD",0)=$S(CNT>0:CNT,1:-1_"^"_"NO DATA FOUND")
  1. ..I +$G(PSSWDIEN)>0 K ^TMP($J,"PSS51P1") D GETS^DIQ(51.1,+PSSIEN,".01;3*","IE","^TMP($J,""PSS51P1""") D
  1. ...I +$D(^TMP($J,"PSS51P1",51.11))'>0 S ^TMP($J,LIST,+PSSIEN,"WARD",0)=-1_"^"_"NO DATA FOUND" Q
  1. ...S (PSS(2),CNT)=0 F S PSS(2)=$O(^TMP($J,"PSS51P1",51.11,PSS(2))) Q:'PSS(2) D
  1. ....I PSSWDIEN=$P($G(^TMP($J,"PSS51P1",51.11,PSS(2),.01,"I")),"^") D SETWRD2^PSS51P1B Q
  1. ....S ^TMP($J,LIST,+PSSIEN,"WARD",0)="-1^NO DATA FOUND FOR PSSWDIEN #"_PSSWDIEN
  1. I $G(PSSPP)]"",$G(PSSFT)]"" D
  1. .I PSSFT["??" D LOOP^PSS51P1B(5) Q
  1. .D FIND^DIC(51.1,,"@;.01;1;2;2.5;4;5IE;8",,PSSFT,,"AP"_PSSPP,SCR("S"),,"")
  1. .I +$G(^TMP("DILIST",$J,0))'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1. .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
  1. ..S PSSIEN=+^TMP("DILIST",$J,2,PSSXX)
  1. ..S ^TMP($J,LIST,+PSSIEN,.01)=$G(^TMP("DILIST",$J,"ID",PSSXX,.01))
  1. ..S ^TMP($J,LIST,"AP"_PSSPP,$G(^TMP("DILIST",$J,"ID",PSSXX,.01)),+PSSIEN)=""
  1. ..S ^TMP($J,LIST,+PSSIEN,1)=$G(^TMP("DILIST",$J,"ID",PSSXX,1))
  1. ..S ^TMP($J,LIST,+PSSIEN,2)=$G(^TMP("DILIST",$J,"ID",PSSXX,2))
  1. ..S ^TMP($J,LIST,+PSSIEN,2.5)=$G(^TMP("DILIST",$J,"ID",PSSXX,2.5))
  1. ..S ^TMP($J,LIST,+PSSIEN,4)=$G(^TMP("DILIST",$J,"ID",PSSXX,4))
  1. ..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")))
  1. ..S ^TMP($J,LIST,+PSSIEN,8)=$G(^TMP("DILIST",$J,"ID",PSSXX,8))
  1. ..D HOSPLOC(LIST,+PSSIEN)
  1. ..I +$G(PSSWDIEN)'>0 K ^TMP($J,"PSS51P1") D GETS^DIQ(51.1,+PSSIEN,".01;3*","IE","^TMP($J,""PSS51P1""") D
  1. ...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
  1. ...S ^TMP($J,LIST,+PSSIEN,"WARD",0)=$S(CNT>0:CNT,1:-1_"^"_"NO DATA FOUND")
  1. ..I +$G(PSSWDIEN)>0 K ^TMP($J,"PSS51P1") D GETS^DIQ(51.1,+PSSIEN,".01;3*","IE","^TMP($J,""PSS51P1""") D
  1. ...I +$D(^TMP($J,"PSS51P1",51.11))'>0 S ^TMP($J,LIST,+PSSIEN,"WARD",0)=-1_"^"_"NO DATA FOUND" Q
  1. ...S (PSS(2),CNT)=0 F S PSS(2)=$O(^TMP($J,"PSS51P1",51.11,PSS(2))) Q:'PSS(2) D
  1. ....I PSSWDIEN=$P($G(^TMP($J,"PSS51P1",51.11,PSS(2),.01,"I")),"^") D SETWRD2^PSS51P1B Q
  1. ....S ^TMP($J,LIST,+PSSIEN,"WARD",0)="-1^NO DATA FOUND FOR PSSWDIEN #"_PSSWDIEN
  1. K ^TMP("DILIST",$J),^TMP($J,"PSS51P1")
  1. Q
  1. ;
  1. HOSPLOC(LIST,PSSIEN) ;
  1. N PSSCNT S PSSCNT=0
  1. N PSSHOSP D GETS^DIQ(51.1,+PSSIEN,"7*","IE","PSSHOSP")
  1. N PSSTIM S PSSTIM=0 F S PSSTIM=$O(PSSHOSP(51.17,PSSTIM)) Q:'PSSTIM D
  1. .S ^TMP($J,LIST,+PSSIEN,"HOSPITAL LOCATION",+PSSTIM,.01)=PSSHOSP(51.17,PSSTIM,.01,"I")_U_PSSHOSP(51.17,PSSTIM,.01,"E")
  1. .S ^TMP($J,LIST,+PSSIEN,"HOSPITAL LOCATION",+PSSTIM,1)=$S(PSSHOSP(51.17,PSSTIM,1,"I")="":"",1:PSSHOSP(51.17,PSSTIM,1,"I"))
  1. .S PSSCNT=PSSCNT+1
  1. S ^TMP($J,LIST,+PSSIEN,"HOSPITAL LOCATION",0)=$S(PSSCNT>0:PSSCNT,1:"-1^NO DATA FOUND")
  1. Q
  1. ;
  1. IX ;
  1. N CNT
  1. K ^TMP($J,LIST)
  1. I $G(PSSPP)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1. I $G(PSSFT)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1. I $G(PSSPP)]"",$G(PSSFT)]"" D
  1. .I PSSFT["??" D LOOP^PSS51P1B(6) Q
  1. .D FIND^DIC(51.1,,"@;.01","QP",PSSFT,,"AP"_PSSPP,,,"")
  1. .I +$G(^TMP("DILIST",$J,0))'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1. .I +^TMP("DILIST",$J,0)>0 N PSSXX S (PSSXX,CNT)=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
  1. ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0)
  1. ..K PSS51P1 D GETS^DIQ(51.1,+PSSIEN,".01;1;2;2.5;4;5;6;8;8.1","IE","PSS51P1")
  1. ..N PSSXX S PSSXX=0 F S PSSXX=$O(PSS51P1(51.1,PSSXX)) Q:'PSSXX D S CNT=CNT+1
  1. ...S ^TMP($J,LIST,+PSSXX,.01)=$G(PSS51P1(51.1,PSSXX,.01,"E"))
  1. ...S ^TMP($J,LIST,"AP"_PSSPP,$G(PSS51P1(51.1,PSSXX,.01,"E")),+PSSXX)=""
  1. ...S ^TMP($J,LIST,+PSSXX,1)=$G(PSS51P1(51.1,PSSXX,1,"E"))
  1. ...S ^TMP($J,LIST,+PSSXX,2)=$G(PSS51P1(51.1,PSSXX,2,"E"))
  1. ...S ^TMP($J,LIST,+PSSXX,2.5)=$G(PSS51P1(51.1,PSSXX,2.5,"E"))
  1. ...S ^TMP($J,LIST,+PSSXX,4)=$G(PSS51P1(51.1,PSSXX,4,"E"))
  1. ...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:"")
  1. ...S ^TMP($J,LIST,+PSSXX,6)=$G(PSS51P1(51.1,PSSXX,6,"E"))
  1. ...S ^TMP($J,LIST,+PSSXX,8)=$G(PSS51P1(51.1,PSSXX,8,"E"))
  1. ...S ^TMP($J,LIST,+PSSXX,8.1)=$G(PSS51P1(51.1,PSSXX,8.1,"E"))
  1. ..S ^TMP($J,LIST,0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
  1. K PSS51P1
  1. K ^TMP("DILIST",$J)
  1. Q
  1. ;
  1. IEN ;
  1. I $G(PSSFT)]"" D
  1. .I PSSFT["??" D LOOP^PSS51P1B(4) Q
  1. .D FIND^DIC(51.1,,"@;.01;1","QP",PSSFT,,"B",,,"PSS51P1")
  1. .I +PSS51P1("DILIST",0)=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1. .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
  1. ..S ^TMP($J,LIST,+$G(PSS51P1("DILIST",PSSXX,0)),.01)=$P($G(PSS51P1("DILIST",PSSXX,0)),"^",2)
  1. ..S ^TMP($J,LIST,+$G(PSS51P1("DILIST",PSSXX,0)),1)=$P($G(PSS51P1("DILIST",PSSXX,0)),"^",3)
  1. ..S ^TMP($J,LIST,"B",$P($G(PSS51P1("DILIST",PSSXX,0)),"^",2),+$G(PSS51P1("DILIST",PSSXX,0)))=""
  1. K ^TMP("DILIST",$J)
  1. Q