PSS50AQM ;BIR/LDT - CONTINUATION OF API FOR INFORMATION FROM FILE 50; 5 Sep 03
 ;;1.0;PHARMACY DATA MANAGEMENT;**85,91,104**;9/30/97
 ;External reference to PS(50.3 supported by DBIA 2127
 ;External reference to PS(50.605 supported by DBIA 2138
 ;External reference to PSNDF(50.6 supported by DBIA 2079
 ;External reference to PSNDF(50.68 supported by DBIA 3735
 ;
SETALL ;
 N PSSZNODE,PSS660,PSSNDNOD,PSS2NODE,PSSG2NOD S PSSZNODE=$G(^PSDRUG(PSS(1),0)),PSS2NODE=$G(^(2)),PSS660=$G(^(660)),PSSG2NOD=$G(^("PSG")),PSSNDNOD=$G(^("ND"))
 S ^TMP($J,LIST,+PSS(1),.01)=$P(PSSZNODE,"^")
 S ^TMP($J,LIST,"B",$P(PSSZNODE,"^"),+PSS(1))=""
 S ^TMP($J,LIST,+PSS(1),2)=$P(PSSZNODE,"^",2)
 S ^TMP($J,LIST,+PSS(1),2.1)=$S('$P(PSS2NODE,"^"):"",1:$P(PSS2NODE,"^")_"^"_$P($G(^PS(50.7,+$P(PSS2NODE,"^"),0)),"^"))
 N PSSADDF S PSSADDF=$P($G(^PS(50.7,+$P($G(^TMP($J,LIST,+PSS(1),2.1)),"^"),0)),"^",2) I PSSADDF>0 D
 .S ^TMP($J,LIST,+PSS(1),2.1)=^TMP($J,LIST,+PSS(1),2.1)_"^"_PSSADDF_"^"_$P($G(^PS(50.606,PSSADDF,0)),"^")
 S ^TMP($J,LIST,+PSS(1),3)=$P(PSSZNODE,"^",3)
 S ^TMP($J,LIST,+PSS(1),4)=$P(PSSZNODE,"^",4)
 S ^TMP($J,LIST,+PSS(1),5)=$P(PSSZNODE,"^",5)
 S ^TMP($J,LIST,+PSS(1),6)=$P(PSSZNODE,"^",6)
 S ^TMP($J,LIST,+PSS(1),8)=$P(PSSZNODE,"^",8)
 S ^TMP($J,LIST,+PSS(1),12)=$S($P(PSS660,"^",2):$P(PSS660,"^",2)_"^"_$P($G(^DIC(51.5,+$P(PSS660,"^",2),0)),"^")_"^"_$P($G(^(0)),"^",2),1:"")
 S ^TMP($J,LIST,+PSS(1),13)=$P(PSS660,"^",3)
 S ^TMP($J,LIST,+PSS(1),14.5)=$P(PSS660,"^",8)
 S ^TMP($J,LIST,+PSS(1),15)=$P(PSS660,"^",5)
 S ^TMP($J,LIST,+PSS(1),16)=$P(PSS660,"^",6)
 S ^TMP($J,LIST,+PSS(1),20)=$S($P(PSSNDNOD,"^"):$P(PSSNDNOD,"^")_"^"_$P($G(^PSNDF(50.6,+$P(PSSNDNOD,"^"),0)),"^"),1:"")
 S ^TMP($J,LIST,+PSS(1),21)=$P(PSSNDNOD,"^",2)
 S ^TMP($J,LIST,+PSS(1),22)=$S($P(PSSNDNOD,"^",3):$P(PSSNDNOD,"^",3)_"^"_$P($G(^PSNDF(50.68,+$P(PSSNDNOD,"^",3),0)),"^"),1:"")
 S ^TMP($J,LIST,+PSS(1),25)=$S($P(PSSNDNOD,"^",6):$P(PSSNDNOD,"^",6)_"^"_$P($G(^PS(50.605,+$P(PSSNDNOD,"^",6),0)),"^")_"^"_$P($G(^(0)),"^",2),1:"")
 S ^TMP($J,LIST,+PSS(1),27)=$P(PSSNDNOD,"^",10)
 S ^TMP($J,LIST,+PSS(1),31)=$P(PSS2NODE,"^",4)
 S ^TMP($J,LIST,+PSS(1),40)=$P($G(^PSDRUG(PSS(1),"PSO")),"^")
 N PSS51NF S PSS51NF=$P(PSSZNODE,"^",9)  D
 .I PSS51NF'="",PSS51NFD'="",PSS51NFD[(PSS51NF_":") S ^TMP($J,LIST,+PSS(1),51)=PSS51NF_"^"_$P($E(PSS51NFD,$F(PSS51NFD,(PSS51NF_":")),999),";") Q
 .S ^TMP($J,LIST,+PSS(1),51)=""
 N PSS52NF S PSS52NF=$P(PSSZNODE,"^",11)  D
 .I PSS52NF'="",PSS52NFD'="",PSS52NFD[(PSS52NF_":") S ^TMP($J,LIST,+PSS(1),52)=PSS52NF_"^"_$P($E(PSS52NFD,$F(PSS52NFD,(PSS52NF_":")),999),";") Q
 .S ^TMP($J,LIST,+PSS(1),52)=""
 S ^TMP($J,LIST,+PSS(1),63)=$P(PSS2NODE,"^",3)
 S ^TMP($J,LIST,+PSS(1),64)=$S($P(PSS2NODE,"^",6):$P(PSS2NODE,"^",6)_"^"_$P($G(^PS(50.3,+$P(PSS2NODE,"^",6),0)),"^"),1:"")
 N Y S Y=$P($G(^PSDRUG(PSS(1),"I")),"^") D
 .I Y S ^TMP($J,LIST,+PSS(1),100)=$G(Y) X ^DD("DD") S ^TMP($J,LIST,+PSS(1),100)=^TMP($J,LIST,+PSS(1),100)_"^"_$G(Y) Q
 .S ^TMP($J,LIST,+PSS(1),100)=""
 S ^TMP($J,LIST,+PSS(1),101)=$P(PSSZNODE,"^",10)
 S ^TMP($J,LIST,+PSS(1),102)=$P(PSS2NODE,"^",2)
 N PSSG2 S PSSG2=$P(PSSG2NOD,"^",2)  D
 .I PSSG2'="",PSSG2N'="",PSSG2N[(PSSG2_":") S ^TMP($J,LIST,+PSS(1),301)=PSSG2_"^"_$P($E(PSSG2N,$F(PSSG2N,(PSSG2_":")),999),";") Q
 .S ^TMP($J,LIST,+PSS(1),301)=""
 S ^TMP($J,LIST,+PSS(1),302)=$P(PSSG2NOD,"^",3)
 ;Set new Service Code field
 I $$PATCH^XPDUTL("PSS*1.0*92") D
 .S ^TMP($J,LIST,+PSS(1),400)=$P($G(^PSDRUG(+PSS(1),"PFS")),"^")
 .I $P(PSSNDNOD,"^",3),$P($G(^PSNDF(50.68,+$P(PSSNDNOD,"^",3),"PFS")),"^")'="" S ^TMP($J,LIST,+PSS(1),400)=$P($G(^PSNDF(50.68,+$P(PSSNDNOD,"^",3),"PFS")),"^")
 .I $P($G(^TMP($J,LIST,+PSS(1),400)),"^")="" S ^TMP($J,LIST,+PSS(1),400)=600000
 Q
 ;
 ;
SETSYN ;
 N PSS501C S PSS501C=0
 I $O(^PSDRUG(PSS(1),1,0)) N PSS501,PSS501ND  D
 .F PSS501=0:0 S PSS501=$O(^PSDRUG(PSS(1),1,PSS501)) Q:'PSS501  D
 ..S PSS501ND=$G(^PSDRUG(PSS(1),1,PSS501,0)) I $P(PSS501ND,"^")'="" S PSS501C=PSS501C+1 D
 ...S ^TMP($J,LIST,+PSS(1),"SYN",PSS501,.01)=$P(PSS501ND,"^")
 ...N PSS501NN S PSS501NN=$P(PSS501ND,"^",3)  D
 ....I PSS501NN'="",PSS501NX'="",PSS501NX[(PSS501NN_":") S ^TMP($J,LIST,+PSS(1),"SYN",PSS501,1)=PSS501NN_"^"_$P($E(PSS501NX,$F(PSS501NX,(PSS501NN_":")),999),";") Q
 ....S ^TMP($J,LIST,+PSS(1),"SYN",PSS501,1)=""
 ...S ^TMP($J,LIST,+PSS(1),"SYN",PSS501,2)=$P(PSS501ND,"^",2)
 ...S ^TMP($J,LIST,+PSS(1),"SYN",PSS501,403)=$P(PSS501ND,"^",7)
 S ^TMP($J,LIST,+PSS(1),"SYN",0)=$S(PSS501C:PSS501C,1:"-1^NO DATA FOUND")
 Q
 ;
SETFMA ;
 N PSS65C S PSS65C=0
 I $O(^PSDRUG(PSS(1),65,0)) N PSS65,PSS65ND D
 .F PSS65=0:0 S PSS65=$O(^PSDRUG(PSS(1),65,PSS65)) Q:'PSS65  D
 ..S PSS65ND=$G(^PSDRUG(PSS(1),65,PSS65,0)) I $P(PSS65ND,"^") S PSS65C=PSS65C+1 D
 ...S ^TMP($J,LIST,+PSS(1),"FRM",PSS65,.01)=$P(PSS65ND,"^")_"^"_$P($G(^PSDRUG(+$P(PSS65ND,"^"),0)),"^")
 S ^TMP($J,LIST,+PSS(1),"FRM",0)=$S(PSS65C:PSS65C,1:"-1^NO DATA FOUND")
 Q
 ;
SETOLD ;
 N PSS900C S PSS900C=0
 I $O(^PSDRUG(PSS(1),900,0)) N PSS900,PSS900ND D
 .F PSS900=0:0 S PSS900=$O(^PSDRUG(PSS(1),900,PSS900)) Q:'PSS900  D
 ..S PSS900ND=$G(^PSDRUG(PSS(1),900,PSS900,0)) I $P(PSS900ND,"^")'="" S PSS900C=PSS900C+1 D
 ...S ^TMP($J,LIST,+PSS(1),"OLD",PSS900,.01)=$P(PSS900ND,"^")
 ...N Y S Y=$P(PSS900ND,"^",2) I Y S ^TMP($J,LIST,+PSS(1),"OLD",PSS900,.02)=$G(Y) X ^DD("DD") S ^TMP($J,LIST,+PSS(1),"OLD",PSS900,.02)=^TMP($J,LIST,+PSS(1),"OLD",PSS900,.02)_"^"_$G(Y)
 S ^TMP($J,LIST,+PSS(1),"OLD",0)=$S(PSS900C:PSS900C,1:"-1^NO DATA FOUND")
 Q
SETSUB1(PSST1) ;Set sub-header nodes if there is data, and sub-header nodes do not exist
 N PSST2,PSST3,PSST4
 I $G(^PSDRUG(PSST1,1,0))="",$O(^PSDRUG(PSST1,1,0)) D
 .S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,1,PSST2)) Q:'PSST2  I $D(^PSDRUG(PSST1,1,PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
 .I PSST4 S ^PSDRUG(PSST1,1,0)="^50.1A^"_PSST3_"^"_PSST4
 Q
SETSUB2(PSST1) ;
 N PSST2,PSST3,PSST4
 I $G(^PSDRUG(PSST1,65,0))="",$O(^PSDRUG(PSST1,65,0)) D
 .S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,65,PSST2)) Q:'PSST2  I $D(^PSDRUG(PSST1,65,PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
 .I PSST4 S ^PSDRUG(PSST1,65,0)="^50.065P^"_PSST3_"^"_PSST4
 Q
SETSUB3(PSST1) ;
 N PSST2,PSST3,PSST4
 I $G(^PSDRUG(PSST1,900,0))="",$O(^PSDRUG(PSST1,900,0)) D
 .S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,900,PSST2)) Q:'PSST2  I $D(^PSDRUG(PSST1,900,PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
 .I PSST4 S ^PSDRUG(PSST1,900,0)="^50.01A^"_PSST3_"^"_PSST4
 Q
SETSUB4(PSST1) ;
 N PSST2,PSST3,PSST4
 I $G(^PSDRUG(PSST1,441,0))="",$O(^PSDRUG(PSST1,441,0)) D
 .S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,441,PSST2)) Q:'PSST2  I $D(^PSDRUG(PSST1,441,PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
 .I PSST4 S ^PSDRUG(PSST1,441,0)="^50.0441P^"_PSST3_"^"_PSST4
 Q
SETSUB5(PSST1) ;
 N PSST2,PSST3,PSST4
 I $G(^PSDRUG(PSST1,4,0))="",$O(^PSDRUG(PSST1,4,0)) D
 .S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,4,PSST2)) Q:'PSST2  I $D(^PSDRUG(PSST1,4,PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
 .I PSST4 S ^PSDRUG(PSST1,4,0)="^50.0214DA^"_PSST3_"^"_PSST4
 Q
SETSUB6(PSST1) ;
 N PSST2,PSST3,PSST4
 I $G(^PSDRUG(PSST1,"CLOZ2",0))="",$O(^PSDRUG(PSST1,"CLOZ2",0)) D
 .S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,"CLOZ2",PSST2)) Q:'PSST2  I $D(^PSDRUG(PSST1,"CLOZ2",PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
 .I PSST4 S ^PSDRUG(PSST1,"CLOZ2",0)="^50.02P^"_PSST3_"^"_PSST4
 Q
SETSUB7(PSST1) ;
 N PSST2,PSST3,PSST4
 I $G(^PSDRUG(PSST1,"DOS1",0))="",$O(^PSDRUG(PSST1,"DOS1",0)) D
 .S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,"DOS1",PSST2)) Q:'PSST2  I $D(^PSDRUG(PSST1,"DOS1",PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
 .I PSST4 S ^PSDRUG(PSST1,"DOS1",0)="^50.0903^"_PSST3_"^"_PSST4
 Q
SETSUB8(PSST1) ;
 N PSST2,PSST3,PSST4
 I $G(^PSDRUG(PSST1,"DOS2",0))="",$O(^PSDRUG(PSST1,"DOS2",0)) D
 .S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,"DOS2",PSST2)) Q:'PSST2  I $D(^PSDRUG(PSST1,"DOS2",PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
 .I PSST4 S ^PSDRUG(PSST1,"DOS2",0)="^50.0904^"_PSST3_"^"_PSST4
 Q
SETSUB9(PSST1) ;
 N PSST2,PSST3,PSST4
 I $G(^PSDRUG(PSST1,212,0))="",$O(^PSDRUG(PSST1,212,0)) D
 .S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,212,PSST2)) Q:'PSST2  I $D(^PSDRUG(PSST1,212,PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
 .I PSST4 S ^PSDRUG(PSST1,212,0)="^50.0212P^"_PSST3_"^"_PSST4
 Q
SETDF(PSSIEN) ;
 ;PSSIEN - IEN of entry in PHARMACY ORDERABLE ITEM file (#50.7).
 ;Returns NAME field (#.01) of PHARMACY ORDERABLE ITEM file (#50.7) and DOSAGE FORM
 N DIERR,ZZERR,PSS50P7,PSS
 I +$G(PSSIEN)'>0 Q -1_"^"_"NO DATA FOUND"
 D GETS^DIQ(50.7,+PSSIEN,".01;.02","IE","PSS50P7")
 I '$D(PSS50P7) Q -1_"^"_"NO DATA FOUND"
 Q $G(PSSIEN)_"^"_$G(PSS50P7(50.7,PSSIEN_",",.01,"I"))_"^"_$G(PSS50P7(50.7,PSSIEN_",",.02,"I"))_"^"_$G(PSS50P7(50.7,PSSIEN_",",.02,"E"))