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

PSS50C1.m

Go to the documentation of this file. 
  1. PSS50C1 ;BIR/RTR - APIs for encapsulation continued; 5 Sep 03
  1.  ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
  1.  ;
  1. SETWS ;
  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),300)=$G(^TMP("PSSP50",$J,50,PSS(1),300,"I"))
  1.  S ^TMP($J,LIST,+PSS(1),301)=$S($G(^TMP("PSSP50",$J,50,PSS(1),301,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),301,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),301,"E")))
  1.  S ^TMP($J,LIST,+PSS(1),302)=$G(^TMP("PSSP50",$J,50,PSS(1),302,"I"))
  1.  Q
  1.  ;
  1. LOOP ;
  1.  N PSS50DD6,PSS50ER6,PSSPCATS D FIELD^DID(50,301,"Z","POINTER","PSS50DD6","PSS50ER6") S PSSPCATS=$G(PSS50DD6("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 SETWSL
  1.  .S PSSENCT=PSSENCT+1
  1.  S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
  1.  Q
  1.  ;
  1. SETWSL ;
  1.  N PSSZNODE,PSSPSGND
  1.  S PSSZNODE=$G(^PSDRUG(PSS(1),0)),PSSPSGND=$G(^("PSG"))
  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),300)=$P(PSSPSGND,"^")
  1.  N PSSPCAT S PSSPCAT=$P(PSSPSGND,"^",2)  D
  1.  .I PSSPCAT'="",PSSPCATS'="",PSSPCATS[(PSSPCAT_":") S ^TMP($J,LIST,+PSS(1),301)=PSSPCAT_"^"_$P($E(PSSPCATS,$F(PSSPCATS,(PSSPCAT_":")),999),";") Q
  1.  .S ^TMP($J,LIST,+PSS(1),301)=""
  1.  S ^TMP($J,LIST,+PSS(1),302)=$P(PSSPSGND,"^",3)
  1.  Q
  1.  ;
  1. LOOPMR ;
  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 SETMRTNL
  1.  .S PSSENCT=PSSENCT+1
  1.  S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
  1.  Q
  1.  ;
  1. SETMRTN ;
  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),17.2)=$S($G(^TMP("PSSP50",$J,50,PSS(1),17.2,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),17.2,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),17.2,"E")))
  1.  S ^TMP($J,LIST,+PSS(1),17.5)=$G(^TMP("PSSP50",$J,50,PSS(1),17.5,"I"))
  1.  S ^TMP($J,LIST,+PSS(1),31)=$G(^TMP("PSSP50",$J,50,PSS(1),31,"I"))
  1.  Q
  1. SETMRTNL ;
  1.  N PSSZNODE,PSS50CL,PSS50CL1,PSS50CL2
  1.  S PSSZNODE=$G(^PSDRUG(PSS(1),0)),PSS50CL=$G(^("CLOZ")),PSS50CL1=$G(^("CLOZ1")),PSS50CL2=$G(^(2))
  1.  S ^TMP($J,LIST,+PSS(1),.01)=$P(PSSZNODE,"^")
  1.  S ^TMP($J,LIST,"B",$P(PSSZNODE,"^"),+PSS(1))=""
  1.  N PSSCLZAR D GETS^DIQ(50,+PSS(1),"17.2","IE","PSSCLZAR")
  1.  S ^TMP($J,LIST,+PSS(1),17.2)=$S($G(PSSCLZAR(50,+PSS(1)_",",17.2,"I"))="":"",1:$G(PSSCLZAR(50,+PSS(1)_",",17.2,"I"))_"^"_$G(PSSCLZAR(50,+PSS(1)_",",17.2,"E")))
  1.  S ^TMP($J,LIST,+PSS(1),17.5)=$P(PSS50CL1,"^")
  1.  S ^TMP($J,LIST,+PSS(1),31)=$P(PSS50CL2,"^",4)
  1.  Q
  1. SETZRO ;
  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),2)=$G(^TMP("PSSP50",$J,50,PSS(1),2,"I"))
  1.  S ^TMP($J,LIST,+PSS(1),3)=$G(^TMP("PSSP50",$J,50,PSS(1),3,"I"))
  1.  S ^TMP($J,LIST,+PSS(1),4)=$G(^TMP("PSSP50",$J,50,PSS(1),4,"I"))
  1.  S ^TMP($J,LIST,+PSS(1),5)=$G(^TMP("PSSP50",$J,50,PSS(1),5,"I"))
  1.  S ^TMP($J,LIST,+PSS(1),6)=$G(^TMP("PSSP50",$J,50,PSS(1),6,"I"))
  1.  S ^TMP($J,LIST,+PSS(1),8)=$G(^TMP("PSSP50",$J,50,PSS(1),8,"I"))
  1.  S ^TMP($J,LIST,+PSS(1),51)=$S($G(^TMP("PSSP50",$J,50,PSS(1),51,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),51,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),51,"E")))
  1.  S ^TMP($J,LIST,+PSS(1),52)=$S($G(^TMP("PSSP50",$J,50,PSS(1),52,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),52,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),52,"E")))
  1.  S ^TMP($J,LIST,+PSS(1),101)=$G(^TMP("PSSP50",$J,50,PSS(1),101,"I"))
  1.  Q
  1. LOOPZR ;
  1.  N PSS50DD7,PSS50DD8,PSS50ER7,PSS50ER8,PSS51NFD,PSS52NFD
  1.  D FIELD^DID(50,51,"Z","POINTER","PSS50DD7","PSS50ER7") S PSS51NFD=$G(PSS50DD7("POINTER"))
  1.  D FIELD^DID(50,52,"Z","POINTER","PSS50DD8","PSS50ER8") S PSS52NFD=$G(PSS50DD8("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 LOOPZRD
  1.  .S PSSENCT=PSSENCT+1
  1.  S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
  1.  Q
  1. LOOPZRD ;
  1.  N PSSZNODE
  1.  S PSSZNODE=$G(^PSDRUG(PSS(1),0))
  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),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.  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),101)=$P(PSSZNODE,"^",10)
  1.  Q
  1. LOOPB ;
  1.  N PSSENCT,PSSZNAM
  1.  S PSSENCT=0
  1.  S PSS(1)=0 F  S PSS(1)=$O(^PSDRUG(PSS(1))) Q:'PSS(1)  D
  1.  .S PSSZNAM=$P($G(^PSDRUG(PSS(1),0)),"^")
  1.  .I PSSZNAM="" 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 ^TMP($J,LIST,+PSS(1),.01)=PSSZNAM
  1.  .S ^TMP($J,LIST,"B",PSSZNAM,+PSS(1))=""
  1.  .S PSSENCT=PSSENCT+1
  1.  S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
  1.  Q
  1. CSYN ;
  1.  ;PSSIEN = internal entry number from Drug (#50) file
  1.  ;PSSVAL = Synonym name
  1.  ;LIST = Global return subscript
  1.  I $G(LIST)']"" Q
  1.  K ^TMP($J,LIST)
  1.  I '$G(PSSIEN)!($G(PSSVAL)="") S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
  1.  N PSSCSNAM,PSSCSX,PSSCSSYN
  1.  S PSSCSNAM=$P($G(^PSDRUG(PSSIEN,0)),"^") I PSSCSNAM="" S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
  1.  S PSSCSX=$O(^PSDRUG("C",PSSVAL,PSSIEN,"")) I 'PSSCSX S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
  1.  S PSSCSSYN=$P($G(^PSDRUG(PSSIEN,1,PSSCSX,0)),"^") I PSSCSSYN="" S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
  1.  S ^TMP($J,LIST,PSSIEN,.01)=PSSCSNAM
  1.  S ^TMP($J,LIST,PSSIEN,"SYN",0)=1
  1.  S ^TMP($J,LIST,PSSIEN,"SYN",PSSCSX,.01)=PSSCSSYN
  1.  S ^TMP($J,LIST,PSSIEN,"SYN",PSSCSX,403)=$P($G(^PSDRUG(PSSIEN,1,PSSCSX,0)),"^",7)
  1.  S ^TMP($J,LIST,"C",PSSCSSYN,PSSIEN)=""
  1.  S ^TMP($J,LIST,0)=1
  1.  Q
  1. DSPUNT ;
  1.  ;PSSIEN = internal entry number from Drug (#50) file
  1.  ;PSSIEN2 = internal entry from the Synonym multiple
  1.  ;LIST = Global return subscript
  1.  I $G(LIST)']"" Q
  1.  K ^TMP($J,LIST)
  1.  I +$G(PSSIEN)'>0!(+$G(PSSIEN2)'>0) S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1.  N PSSDSNAM,PSSDSX,PSSDSSYN
  1.  S PSSDSNAM=$P($G(^PSDRUG(PSSIEN,0)),"^") I PSSDSNAM="" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1.  S PSSDSSYN=$P($G(^PSDRUG(PSSIEN,1,PSSIEN2,0)),"^") I PSSDSSYN="" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1.  S ^TMP($J,LIST,PSSIEN,.01)=PSSDSNAM
  1.  S ^TMP($J,LIST,PSSIEN,"SYN",0)=1
  1.  S ^TMP($J,LIST,PSSIEN,"SYN",PSSIEN2,.01)=PSSDSSYN
  1.  S ^TMP($J,LIST,PSSIEN,"SYN",PSSIEN2,403)=$P($G(^PSDRUG(PSSIEN,1,PSSIEN2,0)),"^",7)
  1.  S ^TMP($J,LIST,"C",PSSDSSYN,PSSIEN)=""
  1.  S ^TMP($J,LIST,0)=1
  1.  Q
  1.  ;
  1. SETSCRN ;Set Screen
  1.  I +$G(PSSFL)>0 D
  1.  .;Naked reference below refers to ^PSDRUG(+Y,"I")
  1.  .I SCR("S")]"" S SCR("S")=SCR("S")_" S PSS5ND=$P($G(^(""I"")),""^"") I PSS5ND=""""!(PSS5ND>PSSFL)" Q
  1.  .;Naked reference below refers to ^PSDRUG(+Y,"I")
  1.  .S SCR("S")="S PSS5ND=$P($G(^(""I"")),""^"") I PSS5ND=""""!(PSS5ND>PSSFL)"
  1.  I $G(PSSRTOI)=1 D
  1.  .;Naked reference below refers to ^PSDRUG(+Y,2)
  1.  .I SCR("S")]"" S SCR("S")=SCR("S")_" I $P($G(^(2)),""^"")" Q
  1.  .;Naked reference below refers to ^PSDRUG(+Y,2)
  1.  .S SCR("S")="I $P($G(^(2)),""^"")"
  1.  I $G(PSSPK)]"" D
  1.  .;Naked reference below refers to ^PSDRUG(+Y,2)
  1.  .I SCR("S")]"" S SCR("S")=SCR("S")_" S PSSZ3=0 F PSSZ4=1:1:$L(PSSPK) Q:PSSZ3  I $P($G(^(2)),""^"",3)[$E(PSSPK,PSSZ4) S PSSZ3=1" Q
  1.  .;Naked reference below refers to ^PSDRUG(+Y,2)
  1.  .S SCR("S")="S PSSZ3=0 F PSSZ4=1:1:$L(PSSPK) Q:PSSZ3  I $P($G(^(2)),""^"",3)[$E(PSSPK,PSSZ4) S PSSZ3=1"
  1.  ;I $G(PSSPK)]"" S SCR("S")=$S(SCR("S")]"":SCR("S")_" I $G(^PSDRUG(+Y,2)),$P($G(^PSDRUG(+Y,2)),""^"",3)[PSSPK",1:"I $G(^PSDRUG(+Y,2)),$P($G(^PSDRUG(+Y,2)),""^"",3)[PSSPK")
  1.  Q