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

PSS50AQM.m

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