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