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

PSS50B1.m

Go to the documentation of this file. 
  1. PSS50B1 ;BIR/LDT - API FOR INFORMATION FROM FILE 50; 5 Sep 03
  1.  ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
  1.  ;
  1. LOOP ;
  1.  N PSS50DD5,PSS50ER5,PSS501NX D FIELD^DID(50.1,1,"Z","POINTER","PSS50DD5","PSS50ER5") S PSS501NX=$G(PSS50DD5("POINTER"))
  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.  .D SETSUB1^PSS50AQM(PSS(1)),SETSUB4^PSS50AQM(PSS(1))
  1.  .D SETINV,SETSYN2,SETIFC
  1.  .S PSSENCT=PSSENCT+1
  1.  S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
  1.  Q
  1. SETINV ;
  1.  N PSSZNODE,PSS660,PSS6601
  1.  S PSSZNODE=$G(^PSDRUG(PSS(1),0)),PSS660=$G(^(660)),PSS6601=$G(^(660.1))
  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),11)=$P(PSS660,"^")
  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)=$P(PSS660,"^",4)
  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),17)=$P(PSS660,"^",7)
  1.  S ^TMP($J,LIST,+PSS(1),14.5)=$P(PSS660,"^",8)
  1.  N Y S Y=$P(PSS660,"^",9) D
  1.  .I Y S ^TMP($J,LIST,+PSS(1),17.1)=$G(Y) X ^DD("DD") S ^TMP($J,LIST,+PSS(1),17.1)=^TMP($J,LIST,+PSS(1),17.1)_"^"_$G(Y) Q
  1.  .S ^TMP($J,LIST,+PSS(1),17.1)=""
  1.  S ^TMP($J,LIST,+PSS(1),50)=$P(PSS6601,"^")
  1.  Q
  1. SETSYN2 ;
  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,400)=$P(PSS501ND,"^",4)
  1.  ...S ^TMP($J,LIST,+PSS(1),"SYN",PSS501,401)=$S($P(PSS501ND,"^",5):$P(PSS501ND,"^",5)_"^"_$P($G(^DIC(51.5,+$P(PSS501ND,"^",5),0)),"^")_"^"_$P($G(^(0)),"^",2),1:"")
  1.  ...S ^TMP($J,LIST,+PSS(1),"SYN",PSS501,402)=$P(PSS501ND,"^",6)
  1.  ...S ^TMP($J,LIST,+PSS(1),"SYN",PSS501,403)=$P(PSS501ND,"^",7)
  1.  ...S ^TMP($J,LIST,+PSS(1),"SYN",PSS501,404)=$P(PSS501ND,"^",8)
  1.  ...S ^TMP($J,LIST,+PSS(1),"SYN",PSS501,405)=$P(PSS501ND,"^",9)
  1.  S ^TMP($J,LIST,+PSS(1),"SYN",0)=$S(PSS501C:PSS501C,1:"-1^NO DATA FOUND")
  1.  Q
  1. SETIFC ;
  1.  N PSS441C S PSS441C=0
  1.  I $O(^PSDRUG(PSS(1),441,0)) N PSS441,PSS441ND  D
  1.  .F PSS441=0:0 S PSS441=$O(^PSDRUG(PSS(1),441,PSS441)) Q:'PSS441  D
  1.  ..S PSS441ND=$G(^PSDRUG(PSS(1),441,PSS441,0)) I $P(PSS441ND,"^")'="" S PSS441C=PSS441C+1 D
  1.  ...S ^TMP($J,LIST,+PSS(1),"IFC",PSS441,.01)=$P(PSS441ND,"^")
  1.  S ^TMP($J,LIST,+PSS(1),"IFC",0)=$S(PSS441C:PSS441C,1:"-1^NO DATA FOUND")
  1.  Q
  1.  ;
  1. AVSN ;
  1.  ;PSSVAL - ITEM NUMBER sub-field (#.01) of the IFCAP ITEM NUMBER multiple of the DRUG file (#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.  ;Returns zero node of 50
  1.  I $G(LIST)']"" Q
  1.  K ^TMP($J,LIST)
  1.  I +$G(PSSVAL)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1.  N PSS,CNT,PSSIEN  S (CNT,PSS)=0 F  S PSS=$O(^PSDRUG("AVSN",+PSSVAL,PSS)) Q:'PSS  D
  1.  .N INODE,NODE2 S NODE2=$G(^PSDRUG(+PSS,2)),INODE=$G(^("I"))
  1.  .I +$G(PSSFL)>0,+INODE>0,+INODE'>PSSFL Q
  1.  .;Naked reference below refers to ^PSDRUG(+Y,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.  .K ^TMP($J,"PSS50") D GETS^DIQ(50,+PSS,".01;9*","IE","^TMP($J,""PSS50""") D
  1.  ..S PSS(1)=0 F  S PSS(1)=$O(^TMP($J,"PSS50",50,PSS(1))) Q:'PSS(1)  D
  1.  ...S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP($J,"PSS50",50,PSS(1),.01,"I")),CNT=CNT+1
  1.  ...S ^TMP($J,LIST,"AVSN",$G(^TMP($J,"PSS50",50,PSS(1),.01,"I")),+PSS(1))="",PSSIEN=+PSS(1)
  1.  ..S (CNT(1),PSS(2))=0 F  S PSS(2)=$O(^TMP($J,"PSS50",50.1,PSS(2))) Q:'PSS(2)  D
  1.  ...S ^TMP($J,LIST,+PSSIEN,"SYN",+PSS(2),.01)=$G(^TMP($J,"PSS50",50.1,PSS(2),.01,"I")),CNT(1)=CNT(1)+1
  1.  ...S ^TMP($J,LIST,+PSSIEN,"SYN",+PSS(2),2)=$G(^TMP($J,"PSS50",50.1,PSS(2),2,"I"))
  1.  ...S ^TMP($J,LIST,+PSSIEN,"SYN",+PSS(2),1)=$S($G(^TMP($J,"PSS50",50.1,PSS(2),1,"I"))="":"",1:$G(^TMP($J,"PSS50",50.1,PSS(2),1,"I"))_"^"_$G(^TMP($J,"PSS50",50.1,PSS(2),1,"E")))
  1.  ...S ^TMP($J,LIST,+PSSIEN,"SYN",+PSS(2),400)=$G(^TMP($J,"PSS50",50.1,PSS(2),400,"I"))
  1.  ...S ^TMP($J,LIST,+PSSIEN,"SYN",+PSS(2),401)=$S($G(^TMP($J,"PSS50",50.1,PSS(2),401,"I"))="":"",1:$G(^TMP($J,"PSS50",50.1,PSS(2),401,"I"))_"^"_$G(^TMP($J,"PSS50",50.1,PSS(2),401,"E")))
  1.  ...S ^TMP($J,LIST,+PSSIEN,"SYN",+PSS(2),402)=$G(^TMP($J,"PSS50",50.1,PSS(2),402,"I"))
  1.  ...S ^TMP($J,LIST,+PSSIEN,"SYN",+PSS(2),403)=$G(^TMP($J,"PSS50",50.1,PSS(2),403,"I"))
  1.  ...S ^TMP($J,LIST,+PSSIEN,"SYN",+PSS(2),404)=$G(^TMP($J,"PSS50",50.1,PSS(2),404,"I"))
  1.  ...S ^TMP($J,LIST,+PSSIEN,"SYN",+PSS(2),405)=$G(^TMP($J,"PSS50",50.1,PSS(2),405,"I"))
  1.  ..S ^TMP($J,LIST,+PSSIEN,"SYN",0)=$S(CNT(1)>0:CNT(1),1:"-1^NO DATA FOUND")
  1.  S ^TMP($J,LIST,0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
  1.  K ^TMP($J,"PSS50")
  1.  Q
  1.  ;
  1. AQ1 ;
  1.  ;PSSVAL - ITEM NUMBER sub-field (#.01) of the IFCAP ITEM NUMBER multiple of the DRUG file (#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.  ;Returns zero node of 50
  1.  I $G(LIST)']"" Q
  1.  K ^TMP($J,LIST)
  1.  I $G(PSSVAL)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1.  N PSS,CNT S (CNT,PSS)=0 F  S PSS=$O(^PSDRUG("AQ1",PSSVAL,PSS)) Q:'PSS  D
  1.  .N INODE,NODE2,ZNODE S NODE2=$G(^PSDRUG(+PSS,2)),INODE=$G(^("I")),ZNODE=$G(^(0))
  1.  .I +$G(PSSFL)>0,+INODE>0,+INODE'>PSSFL Q
  1.  .;Naked reference below refers to ^PSDRUG(+PSS,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 ^TMP($J,LIST,+PSS,.01)=$P(ZNODE,"^"),CNT=CNT+1
  1.  .S ^TMP($J,LIST,"AQ1",$P(ZNODE,"^"),+PSS)=""
  1.  S ^TMP($J,LIST,0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
  1.  Q
  1.  ;
  1. AIU ;
  1.  ;PSSFT - NAME field (#.01) of the DRUG file (#50)
  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.  ;PSSFL - Inactive flag - "" - All entries
  1.  ;                        FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
  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.  ;Returns NAME field (#.01) of DRUG file (#50).
  1.  I $G(LIST)']"" Q
  1.  K ^TMP($J,LIST)
  1.  I $G(PSSFT)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1.  I $G(PSSPK)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1.  N PSS,CNT S CNT=0,PSS="" F  S PSS=$O(^PSDRUG("AIU"_PSSPK,PSS)) Q:PSS=""  S PSS(1)=0 F  S PSS(1)=$O(^PSDRUG("AIU"_PSSPK,PSS,PSS(1))) Q:'PSS(1)  D
  1.  .N INODE,NODE2,ZNODE S NODE2=$G(^PSDRUG(+PSS(1),2)),INODE=$G(^("I")),ZNODE=$G(^(0))
  1.  .I +$G(PSSFL)>0,+INODE>0,+INODE'>PSSFL Q
  1.  .I $E(PSS,1,$L(PSSFT))'[PSSFT Q
  1.  .S ^TMP($J,LIST,+PSS(1),.01)=$P(ZNODE,"^"),CNT=CNT+1
  1.  .S ^TMP($J,LIST,"AIU",$P(ZNODE,"^"),+PSS(1))=""
  1.  S ^TMP($J,LIST,0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
  1.  Q
  1.  ;
  1. IU ;
  1.  ;PSSFL - Inactive flag - "" - All entries
  1.  ;                        FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
  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.  ;Returns NAME field (#.01) of DRUG file (#50).
  1.  I $G(LIST)']"" Q
  1.  K ^TMP($J,LIST)
  1.  N PSS,CNT
  1.  S CNT=0,PSS="" F  S PSS=$O(^PSDRUG("IU",PSS)) Q:PSS=""  I PSS'["O"&(PSS'["U")&(PSS'["I")&(PSS'["N") S PSS(1)=0 F  S PSS(1)=$O(^PSDRUG("IU",PSS,PSS(1))) Q:'PSS(1)  D
  1.  .N INODE,ZNODE S ZNODE=$G(^PSDRUG(+PSS(1),0)),INODE=$G(^("I"))
  1.  .I +$G(PSSFL)>0,+INODE>0,+INODE'>PSSFL Q
  1.  .S ^TMP($J,LIST,+PSS(1),.01)=$P(ZNODE,"^"),CNT=CNT+1
  1.  .S ^TMP($J,LIST,"IU",$P(ZNODE,"^"),+PSS(1))=""
  1.  S ^TMP($J,LIST,0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
  1.  Q