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

PSS50ATC.m

Go to the documentation of this file.
  1. PSS50ATC ;BIR/LDT - API INFORMATION FROM FILE 50; 23 Mar 04
  1. ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
  1. ;
  1. ;External reference to PS(57.5 supported by DBIA 2112
  1. ATC ;
  1. ;PSSIEN - IEN of entry in 50
  1. ;PSSFT - Free Text name in 50
  1. ;PSSFL - Inactive flag - "" - All entries
  1. ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
  1. ;PSSPK - Application Package's Use - "" - All entries
  1. ; Alphabetic codes that represent the DHCP packages that consider this drug to be
  1. ; part of their formulary.
  1. ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
  1. ; piece being returned.
  1. N DIERR,ZZERR,PSSP50,SCR,PSS,PSSMLCT,PSSAXX,PSSAXX1,PSSAXX2,PSSAXXOK
  1. I $G(LIST)']"" Q
  1. K ^TMP($J,LIST)
  1. I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1. S SCR("S")=""
  1. I +$G(PSSFL)>0!($G(PSSPK)]"") N PSS5ND,PSSZ3,PSSZ4 D SETSCRN^PSS50A
  1. I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(50,"","A","`"_PSSIEN,,SCR("S"),"") D K ^TMP("PSSP50",$J) Q
  1. .K ^TMP("DIERR",$J)
  1. .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1. .S PSSAXXOK=0 F PSSAXX=0:0 S PSSAXX=$O(^PSDRUG(+PSSIEN2,212,"AC",PSSAXX)) Q:'PSSAXX!(PSSAXXOK) S PSSAXX1="" F S PSSAXX1=$O(^PSDRUG(+PSSIEN2,212,"AC",PSSAXX,PSSAXX1)) Q:PSSAXX1=""!(PSSAXXOK) D
  1. ..F PSSAXX2=0:0 S PSSAXX2=$O(^PSDRUG(+PSSIEN2,212,"AC",PSSAXX,PSSAXX1,PSSAXX2)) Q:'PSSAXX2!(PSSAXXOK) I $D(^PSDRUG(+PSSIEN2,212,PSSAXX2,0)) S PSSAXXOK=1
  1. .I 'PSSAXXOK S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1. .S ^TMP($J,LIST,0)=1
  1. .D SETSUB9^PSS50AQM(+PSSIEN2)
  1. .K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN2,".01;212.2;212*","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
  1. .F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SETATC D
  1. ..S (PSS(2),PSSMLCT)=0 F S PSS(2)=$O(^TMP("PSSP50",$J,50.0212,PSS(2))) Q:'PSS(2) S PSSMLCT=PSSMLCT+1 D SETATC2
  1. ..S ^TMP($J,LIST,+PSS(1),"ATC",0)=$S($G(PSSMLCT):PSSMLCT,1:"-1^NO DATA FOUND")
  1. I $G(PSSIEN)'="" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1. I $G(PSSFT)]"" D
  1. .I PSSFT["??" D LOOP Q
  1. .K ^TMP("DILIST",$J)
  1. .D FIND^DIC(50,,"@;.01","QP",PSSFT,,"B",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 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 PSSAXXOK=0 F PSSAXX=0:0 S PSSAXX=$O(^PSDRUG(+PSSIEN,212,"AC",PSSAXX)) Q:'PSSAXX!(PSSAXXOK) S PSSAXX1="" F S PSSAXX1=$O(^PSDRUG(+PSSIEN,212,"AC",PSSAXX,PSSAXX1)) Q:PSSAXX1=""!(PSSAXXOK) D
  1. ...F PSSAXX2=0:0 S PSSAXX2=$O(^PSDRUG(+PSSIEN,212,"AC",PSSAXX,PSSAXX1,PSSAXX2)) Q:'PSSAXX2!(PSSAXXOK) I $D(^PSDRUG(+PSSIEN,212,PSSAXX2,0)) S PSSAXXOK=1
  1. ..I 'PSSAXXOK Q
  1. ..S ^TMP($J,LIST,0)=$S('$G(^TMP($J,LIST,0)):1,1:$G(^TMP($J,LIST,0))+1)
  1. ..D SETSUB9^PSS50AQM(PSSIEN) K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN,".01;212.2;212*","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
  1. ..F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SETATC D
  1. ...S (PSS(2),PSSMLCT)=0 F S PSS(2)=$O(^TMP("PSSP50",$J,50.0212,PSS(2))) Q:'PSS(2) S PSSMLCT=PSSMLCT+1 D SETATC2
  1. ...S ^TMP($J,LIST,+PSS(1),"ATC",0)=$S($G(PSSMLCT):PSSMLCT,1:"-1^NO DATA FOUND")
  1. I '$O(^TMP($J,LIST,0)) S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND"
  1. K ^TMP("DILIST",$J),^TMP("PSSP50",$J)
  1. Q
  1. SETATC ;
  1. S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I"))
  1. S ^TMP($J,LIST,+PSS(1),212.2)=$G(^TMP("PSSP50",$J,50,PSS(1),212.2,"I"))
  1. S ^TMP($J,LIST,"AC",$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I")),+PSS(1))=""
  1. Q
  1. ;
  1. SETATC2 ;
  1. S ^TMP($J,LIST,+PSS(1),"ATC",+PSS(2),.01)=$S($G(^TMP("PSSP50",$J,50.0212,PSS(2),.01,"I"))="":"",1:$G(^TMP("PSSP50",$J,50.0212,PSS(2),.01,"I"))_"^"_$G(^TMP("PSSP50",$J,50.0212,PSS(2),.01,"E")))
  1. S ^TMP($J,LIST,+PSS(1),"ATC",+PSS(2),1)=$G(^TMP("PSSP50",$J,50.0212,PSS(2),1,"I"))
  1. Q
  1. SETATCL ;
  1. S ^TMP($J,LIST,+PSS(1),.01)=$P(^PSDRUG(PSS(1),0),"^")
  1. S ^TMP($J,LIST,"AC",$P(^PSDRUG(+PSS(1),0),"^"),+PSS(1))=""
  1. S ^TMP($J,LIST,+PSS(1),212.2)=$P($G(^PSDRUG(+PSS(1),8.5)),"^",2)
  1. Q
  1. SETATCLM ;
  1. N PSS50212 S PSS50212=0
  1. I $O(^PSDRUG(+PSS(1),212,0)) N PSSATCND,PSSAT212 D
  1. .F PSSAT212=0:0 S PSSAT212=$O(^PSDRUG(+PSS(1),212,PSSAT212)) Q:'PSSAT212 D
  1. ..S PSSATCND=$G(^PSDRUG(+PSS(1),212,PSSAT212,0)) I $P(PSSATCND,"^")'="" S PSS50212=PSS50212+1 D
  1. ...S ^TMP($J,LIST,+PSS(1),"ATC",PSSAT212,.01)=$S($P(PSSATCND,"^")&($P($G(^PS(57.5,+$P(PSSATCND,"^"),0)),"^")'=""):$P(PSSATCND,"^")_"^"_$P($G(^PS(57.5,+$P(PSSATCND,"^"),0)),"^"),1:"")
  1. ...S ^TMP($J,LIST,+PSS(1),"ATC",PSSAT212,1)=$P(PSSATCND,"^",2)
  1. S ^TMP($J,LIST,+PSS(1),"ATC",0)=$S(PSS50212:PSS50212,1:"-1^NO DATA FOUND")
  1. Q
  1. LOOP ;
  1. N PSSENCT
  1. S PSSENCT=0
  1. S PSS(1)=0 F S PSS(1)=$O(^PSDRUG(PSS(1))) Q:'PSS(1) D
  1. .I $P($G(^PSDRUG(PSS(1),0)),"^")="" Q
  1. .I $G(PSSFL),$P($G(^PSDRUG(PSS(1),"I")),"^"),$P($G(^("I")),"^")'>PSSFL Q
  1. .;I $G(PSSRTOI)=1,'$P($G(^PSDRUG(PSS(1),2)),"^") Q
  1. .;Naked reference below refers to ^PSDRUG(PSS(1),2)
  1. .I $G(PSSPK)]"" N PSSZ5,PSSZ6 S PSSZ5=0 F PSSZ6=1:1:$L(PSSPK) Q:PSSZ5 I $P($G(^(2)),"^",3)[$E(PSSPK,PSSZ6) S PSSZ5=1
  1. .I $G(PSSPK)]"",'PSSZ5 Q
  1. .S PSSAXXOK=0 F PSSAXX=0:0 S PSSAXX=$O(^PSDRUG(PSS(1),212,"AC",PSSAXX)) Q:'PSSAXX!(PSSAXXOK) S PSSAXX1="" F S PSSAXX1=$O(^PSDRUG(PSS(1),212,"AC",PSSAXX,PSSAXX1)) Q:PSSAXX1=""!(PSSAXXOK) D
  1. ..F PSSAXX2=0:0 S PSSAXX2=$O(^PSDRUG(PSS(1),212,"AC",PSSAXX,PSSAXX1,PSSAXX2)) Q:'PSSAXX2!(PSSAXXOK) I $D(^PSDRUG(PSS(1),212,PSSAXX2,0)) S PSSAXXOK=1
  1. .I 'PSSAXXOK Q
  1. .D SETSUB9^PSS50AQM(PSS(1))
  1. .D SETATCL,SETATCLM
  1. .S PSSENCT=PSSENCT+1
  1. S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
  1. Q
  1. SETSYN2 ;
  1. S ^TMP($J,LIST,+PSS(1),"SYN",+PSS(2),.01)=$G(^TMP("PSSP50",$J,50.1,PSS(2),.01,"I"))
  1. S ^TMP($J,LIST,+PSS(1),"SYN",+PSS(2),1)=$S($G(^TMP("PSSP50",$J,50.1,PSS(2),1,"I"))="":"",1:^TMP("PSSP50",$J,50.1,PSS(2),1,"I")_"^"_^TMP("PSSP50",$J,50.1,PSS(2),1,"E"))
  1. S ^TMP($J,LIST,+PSS(1),"SYN",+PSS(2),2)=$G(^TMP("PSSP50",$J,50.1,PSS(2),2,"I"))
  1. S ^TMP($J,LIST,+PSS(1),"SYN",+PSS(2),400)=$G(^TMP("PSSP50",$J,50.1,PSS(2),400,"I"))
  1. N PSSUTNX S PSSUTNX=$G(^TMP("PSSP50",$J,50.1,PSS(2),401,"I"))
  1. S ^TMP($J,LIST,+PSS(1),"SYN",+PSS(2),401)=$S($G(PSSUTNX)="":"",1:$G(^TMP("PSSP50",$J,50.1,PSS(2),401,"I"))_"^"_$G(^TMP("PSSP50",$J,50.1,PSS(2),401,"E")))
  1. I PSSUTNX'="" S ^TMP($J,LIST,+PSS(1),"SYN",+PSS(2),401)=^TMP($J,LIST,+PSS(1),"SYN",+PSS(2),401)_"^"_$P($G(^DIC(51.5,PSSUTNX,0)),"^",2)
  1. S ^TMP($J,LIST,+PSS(1),"SYN",+PSS(2),402)=$G(^TMP("PSSP50",$J,50.1,PSS(2),402,"I"))
  1. S ^TMP($J,LIST,+PSS(1),"SYN",+PSS(2),403)=$G(^TMP("PSSP50",$J,50.1,PSS(2),403,"I"))
  1. S ^TMP($J,LIST,+PSS(1),"SYN",+PSS(2),404)=$G(^TMP("PSSP50",$J,50.1,PSS(2),404,"I"))
  1. S ^TMP($J,LIST,+PSS(1),"SYN",+PSS(2),405)=$G(^TMP("PSSP50",$J,50.1,PSS(2),405,"I"))
  1. Q
  1. ;
  1. SETINV ;
  1. S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I"))
  1. S ^TMP($J,LIST,"B",$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I")),+PSS(1))=""
  1. S ^TMP($J,LIST,+PSS(1),11)=$G(^TMP("PSSP50",$J,50,PSS(1),11,"I"))
  1. N PSSUTN S PSSUTN=$G(^TMP("PSSP50",$J,50,PSS(1),12,"I"))
  1. S ^TMP($J,LIST,+PSS(1),12)=$S($G(PSSUTN)="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),12,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),12,"E")))
  1. I PSSUTN'="" S ^TMP($J,LIST,+PSS(1),12)=^TMP($J,LIST,+PSS(1),12)_"^"_$P($G(^DIC(51.5,PSSUTN,0)),"^",2)
  1. S ^TMP($J,LIST,+PSS(1),13)=$G(^TMP("PSSP50",$J,50,PSS(1),13,"I"))
  1. S ^TMP($J,LIST,+PSS(1),14)=$G(^TMP("PSSP50",$J,50,PSS(1),14,"I"))
  1. S ^TMP($J,LIST,+PSS(1),15)=$G(^TMP("PSSP50",$J,50,PSS(1),15,"I"))
  1. S ^TMP($J,LIST,+PSS(1),16)=$G(^TMP("PSSP50",$J,50,PSS(1),16,"I"))
  1. S ^TMP($J,LIST,+PSS(1),17)=$G(^TMP("PSSP50",$J,50,PSS(1),17,"I"))
  1. S ^TMP($J,LIST,+PSS(1),14.5)=$G(^TMP("PSSP50",$J,50,PSS(1),14.5,"I"))
  1. S ^TMP($J,LIST,+PSS(1),17.1)=$S($G(^TMP("PSSP50",$J,50,PSS(1),17.1,"I"))="":"",1:^TMP("PSSP50",$J,50,PSS(1),17.1,"I")_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),17.1,"E")))
  1. S ^TMP($J,LIST,+PSS(1),50)=$G(^TMP("PSSP50",$J,50,PSS(1),50,"I"))
  1. Q
  1. SETIFC ;
  1. S ^TMP($J,LIST,+PSS(1),"IFC",+PSS(2),.01)=$S($G(^TMP("PSSP50",$J,50.0441,PSS(2),.01,"I"))="":"",1:^TMP("PSSP50",$J,50.0441,PSS(2),.01,"I"))
  1. Q