PSS50C1 ;BIR/RTR - APIs for encapsulation continued; 5 Sep 03
;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
;
SETWS ;
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),300)=$G(^TMP("PSSP50",$J,50,PSS(1),300,"I"))
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")))
S ^TMP($J,LIST,+PSS(1),302)=$G(^TMP("PSSP50",$J,50,PSS(1),302,"I"))
Q
;
LOOP ;
N PSS50DD6,PSS50ER6,PSSPCATS D FIELD^DID(50,301,"Z","POINTER","PSS50DD6","PSS50ER6") S PSSPCATS=$G(PSS50DD6("POINTER"))
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
.D SETWSL
.S PSSENCT=PSSENCT+1
S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
Q
;
SETWSL ;
N PSSZNODE,PSSPSGND
S PSSZNODE=$G(^PSDRUG(PSS(1),0)),PSSPSGND=$G(^("PSG"))
S ^TMP($J,LIST,+PSS(1),.01)=$P(PSSZNODE,"^")
S ^TMP($J,LIST,"B",$P(PSSZNODE,"^"),+PSS(1))=""
S ^TMP($J,LIST,+PSS(1),300)=$P(PSSPSGND,"^")
N PSSPCAT S PSSPCAT=$P(PSSPSGND,"^",2) D
.I PSSPCAT'="",PSSPCATS'="",PSSPCATS[(PSSPCAT_":") S ^TMP($J,LIST,+PSS(1),301)=PSSPCAT_"^"_$P($E(PSSPCATS,$F(PSSPCATS,(PSSPCAT_":")),999),";") Q
.S ^TMP($J,LIST,+PSS(1),301)=""
S ^TMP($J,LIST,+PSS(1),302)=$P(PSSPSGND,"^",3)
Q
;
LOOPMR ;
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
.D SETMRTNL
.S PSSENCT=PSSENCT+1
S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
Q
;
SETMRTN ;
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),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")))
S ^TMP($J,LIST,+PSS(1),17.5)=$G(^TMP("PSSP50",$J,50,PSS(1),17.5,"I"))
S ^TMP($J,LIST,+PSS(1),31)=$G(^TMP("PSSP50",$J,50,PSS(1),31,"I"))
Q
SETMRTNL ;
N PSSZNODE,PSS50CL,PSS50CL1,PSS50CL2
S PSSZNODE=$G(^PSDRUG(PSS(1),0)),PSS50CL=$G(^("CLOZ")),PSS50CL1=$G(^("CLOZ1")),PSS50CL2=$G(^(2))
S ^TMP($J,LIST,+PSS(1),.01)=$P(PSSZNODE,"^")
S ^TMP($J,LIST,"B",$P(PSSZNODE,"^"),+PSS(1))=""
N PSSCLZAR D GETS^DIQ(50,+PSS(1),"17.2","IE","PSSCLZAR")
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")))
S ^TMP($J,LIST,+PSS(1),17.5)=$P(PSS50CL1,"^")
S ^TMP($J,LIST,+PSS(1),31)=$P(PSS50CL2,"^",4)
Q
SETZRO ;
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),2)=$G(^TMP("PSSP50",$J,50,PSS(1),2,"I"))
S ^TMP($J,LIST,+PSS(1),3)=$G(^TMP("PSSP50",$J,50,PSS(1),3,"I"))
S ^TMP($J,LIST,+PSS(1),4)=$G(^TMP("PSSP50",$J,50,PSS(1),4,"I"))
S ^TMP($J,LIST,+PSS(1),5)=$G(^TMP("PSSP50",$J,50,PSS(1),5,"I"))
S ^TMP($J,LIST,+PSS(1),6)=$G(^TMP("PSSP50",$J,50,PSS(1),6,"I"))
S ^TMP($J,LIST,+PSS(1),8)=$G(^TMP("PSSP50",$J,50,PSS(1),8,"I"))
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")))
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")))
S ^TMP($J,LIST,+PSS(1),101)=$G(^TMP("PSSP50",$J,50,PSS(1),101,"I"))
Q
LOOPZR ;
N PSS50DD7,PSS50DD8,PSS50ER7,PSS50ER8,PSS51NFD,PSS52NFD
D FIELD^DID(50,51,"Z","POINTER","PSS50DD7","PSS50ER7") S PSS51NFD=$G(PSS50DD7("POINTER"))
D FIELD^DID(50,52,"Z","POINTER","PSS50DD8","PSS50ER8") S PSS52NFD=$G(PSS50DD8("POINTER"))
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
.D LOOPZRD
.S PSSENCT=PSSENCT+1
S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
Q
LOOPZRD ;
N PSSZNODE
S PSSZNODE=$G(^PSDRUG(PSS(1),0))
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),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)
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),101)=$P(PSSZNODE,"^",10)
Q
LOOPB ;
N PSSENCT,PSSZNAM
S PSSENCT=0
S PSS(1)=0 F S PSS(1)=$O(^PSDRUG(PSS(1))) Q:'PSS(1) D
.S PSSZNAM=$P($G(^PSDRUG(PSS(1),0)),"^")
.I PSSZNAM="" 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 ^TMP($J,LIST,+PSS(1),.01)=PSSZNAM
.S ^TMP($J,LIST,"B",PSSZNAM,+PSS(1))=""
.S PSSENCT=PSSENCT+1
S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
Q
CSYN ;
;PSSIEN = internal entry number from Drug (#50) file
;PSSVAL = Synonym name
;LIST = Global return subscript
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I '$G(PSSIEN)!($G(PSSVAL)="") S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
N PSSCSNAM,PSSCSX,PSSCSSYN
S PSSCSNAM=$P($G(^PSDRUG(PSSIEN,0)),"^") I PSSCSNAM="" S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
S PSSCSX=$O(^PSDRUG("C",PSSVAL,PSSIEN,"")) I 'PSSCSX S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
S PSSCSSYN=$P($G(^PSDRUG(PSSIEN,1,PSSCSX,0)),"^") I PSSCSSYN="" S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
S ^TMP($J,LIST,PSSIEN,.01)=PSSCSNAM
S ^TMP($J,LIST,PSSIEN,"SYN",0)=1
S ^TMP($J,LIST,PSSIEN,"SYN",PSSCSX,.01)=PSSCSSYN
S ^TMP($J,LIST,PSSIEN,"SYN",PSSCSX,403)=$P($G(^PSDRUG(PSSIEN,1,PSSCSX,0)),"^",7)
S ^TMP($J,LIST,"C",PSSCSSYN,PSSIEN)=""
S ^TMP($J,LIST,0)=1
Q
DSPUNT ;
;PSSIEN = internal entry number from Drug (#50) file
;PSSIEN2 = internal entry from the Synonym multiple
;LIST = Global return subscript
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I +$G(PSSIEN)'>0!(+$G(PSSIEN2)'>0) S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
N PSSDSNAM,PSSDSX,PSSDSSYN
S PSSDSNAM=$P($G(^PSDRUG(PSSIEN,0)),"^") I PSSDSNAM="" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
S PSSDSSYN=$P($G(^PSDRUG(PSSIEN,1,PSSIEN2,0)),"^") I PSSDSSYN="" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
S ^TMP($J,LIST,PSSIEN,.01)=PSSDSNAM
S ^TMP($J,LIST,PSSIEN,"SYN",0)=1
S ^TMP($J,LIST,PSSIEN,"SYN",PSSIEN2,.01)=PSSDSSYN
S ^TMP($J,LIST,PSSIEN,"SYN",PSSIEN2,403)=$P($G(^PSDRUG(PSSIEN,1,PSSIEN2,0)),"^",7)
S ^TMP($J,LIST,"C",PSSDSSYN,PSSIEN)=""
S ^TMP($J,LIST,0)=1
Q
;
SETSCRN ;Set Screen
I +$G(PSSFL)>0 D
.;Naked reference below refers to ^PSDRUG(+Y,"I")
.I SCR("S")]"" S SCR("S")=SCR("S")_" S PSS5ND=$P($G(^(""I"")),""^"") I PSS5ND=""""!(PSS5ND>PSSFL)" Q
.;Naked reference below refers to ^PSDRUG(+Y,"I")
.S SCR("S")="S PSS5ND=$P($G(^(""I"")),""^"") I PSS5ND=""""!(PSS5ND>PSSFL)"
I $G(PSSRTOI)=1 D
.;Naked reference below refers to ^PSDRUG(+Y,2)
.I SCR("S")]"" S SCR("S")=SCR("S")_" I $P($G(^(2)),""^"")" Q
.;Naked reference below refers to ^PSDRUG(+Y,2)
.S SCR("S")="I $P($G(^(2)),""^"")"
I $G(PSSPK)]"" D
.;Naked reference below refers to ^PSDRUG(+Y,2)
.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
.;Naked reference below refers to ^PSDRUG(+Y,2)
.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"
;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")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS50C1 9463 printed Apr 09, 2024@21:37:13 Page 2
PSS50C1 ;BIR/RTR - APIs for encapsulation continued; 5 Sep 03
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
+2 ;
SETWS ;
+1 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),.01,"I"))
+2 SET ^TMP($JOB,LIST,"B",$GET(^TMP("PSSP50",$JOB,50,PSS(1),.01,"I")),+PSS(1))=""
+3 SET ^TMP($JOB,LIST,+PSS(1),300)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),300,"I"))
+4 SET ^TMP($JOB,LIST,+PSS(1),301)=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),301,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),301,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50,PSS(1),301,"E")))
+5 SET ^TMP($JOB,LIST,+PSS(1),302)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),302,"I"))
+6 QUIT
+7 ;
LOOP ;
+1 NEW PSS50DD6,PSS50ER6,PSSPCATS
DO FIELD^DID(50,301,"Z","POINTER","PSS50DD6","PSS50ER6")
SET PSSPCATS=$GET(PSS50DD6("POINTER"))
+2 NEW PSSENCT
+3 SET PSSENCT=0
+4 SET PSS(1)=0
FOR
SET PSS(1)=$ORDER(^PSDRUG(PSS(1)))
if 'PSS(1)
QUIT
Begin DoDot:1
+5 IF $PIECE($GET(^PSDRUG(PSS(1),0)),"^")=""
QUIT
+6 IF $GET(PSSFL)
IF $PIECE($GET(^PSDRUG(PSS(1),"I")),"^")
IF $PIECE($GET(^("I")),"^")'>PSSFL
QUIT
+7 IF $GET(PSSRTOI)=1
IF '$PIECE($GET(^PSDRUG(PSS(1),2)),"^")
QUIT
+8 ;Naked reference below refers to ^PSDRUG(PSS(1),2)
+9 IF $GET(PSSPK)]""
NEW PSSZ5,PSSZ6
SET PSSZ5=0
FOR PSSZ6=1:1:$LENGTH(PSSPK)
if PSSZ5
QUIT
IF $PIECE($GET(^(2)),"^",3)[$EXTRACT(PSSPK,PSSZ6)
SET PSSZ5=1
+10 IF $GET(PSSPK)]""
IF 'PSSZ5
QUIT
+11 DO SETWSL
+12 SET PSSENCT=PSSENCT+1
End DoDot:1
+13 SET ^TMP($JOB,LIST,0)=$SELECT($GET(PSSENCT):$GET(PSSENCT),1:"-1^NO DATA FOUND")
+14 QUIT
+15 ;
SETWSL ;
+1 NEW PSSZNODE,PSSPSGND
+2 SET PSSZNODE=$GET(^PSDRUG(PSS(1),0))
SET PSSPSGND=$GET(^("PSG"))
+3 SET ^TMP($JOB,LIST,+PSS(1),.01)=$PIECE(PSSZNODE,"^")
+4 SET ^TMP($JOB,LIST,"B",$PIECE(PSSZNODE,"^"),+PSS(1))=""
+5 SET ^TMP($JOB,LIST,+PSS(1),300)=$PIECE(PSSPSGND,"^")
+6 NEW PSSPCAT
SET PSSPCAT=$PIECE(PSSPSGND,"^",2)
Begin DoDot:1
+7 IF PSSPCAT'=""
IF PSSPCATS'=""
IF PSSPCATS[(PSSPCAT_":")
SET ^TMP($JOB,LIST,+PSS(1),301)=PSSPCAT_"^"_$PIECE($EXTRACT(PSSPCATS,$FIND(PSSPCATS,(PSSPCAT_":")),999),";")
QUIT
+8 SET ^TMP($JOB,LIST,+PSS(1),301)=""
End DoDot:1
+9 SET ^TMP($JOB,LIST,+PSS(1),302)=$PIECE(PSSPSGND,"^",3)
+10 QUIT
+11 ;
LOOPMR ;
+1 NEW PSSENCT
+2 SET PSSENCT=0
+3 SET PSS(1)=0
FOR
SET PSS(1)=$ORDER(^PSDRUG(PSS(1)))
if 'PSS(1)
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^PSDRUG(PSS(1),0)),"^")=""
QUIT
+5 IF $GET(PSSFL)
IF $PIECE($GET(^PSDRUG(PSS(1),"I")),"^")
IF $PIECE($GET(^("I")),"^")'>PSSFL
QUIT
+6 IF $GET(PSSRTOI)=1
IF '$PIECE($GET(^PSDRUG(PSS(1),2)),"^")
QUIT
+7 ;Naked reference below refers to ^PSDRUG(PSS(1),2)
+8 IF $GET(PSSPK)]""
NEW PSSZ5,PSSZ6
SET PSSZ5=0
FOR PSSZ6=1:1:$LENGTH(PSSPK)
if PSSZ5
QUIT
IF $PIECE($GET(^(2)),"^",3)[$EXTRACT(PSSPK,PSSZ6)
SET PSSZ5=1
+9 IF $GET(PSSPK)]""
IF 'PSSZ5
QUIT
+10 DO SETMRTNL
+11 SET PSSENCT=PSSENCT+1
End DoDot:1
+12 SET ^TMP($JOB,LIST,0)=$SELECT($GET(PSSENCT):$GET(PSSENCT),1:"-1^NO DATA FOUND")
+13 QUIT
+14 ;
SETMRTN ;
+1 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),.01,"I"))
+2 SET ^TMP($JOB,LIST,"B",$GET(^TMP("PSSP50",$JOB,50,PSS(1),.01,"I")),+PSS(1))=""
+3 SET ^TMP($JOB,LIST,+PSS(1),17.2)=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),17.2,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),17.2,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50,PSS(1),17.2,"E")))
+4 SET ^TMP($JOB,LIST,+PSS(1),17.5)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),17.5,"I"))
+5 SET ^TMP($JOB,LIST,+PSS(1),31)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),31,"I"))
+6 QUIT
SETMRTNL ;
+1 NEW PSSZNODE,PSS50CL,PSS50CL1,PSS50CL2
+2 SET PSSZNODE=$GET(^PSDRUG(PSS(1),0))
SET PSS50CL=$GET(^("CLOZ"))
SET PSS50CL1=$GET(^("CLOZ1"))
SET PSS50CL2=$GET(^(2))
+3 SET ^TMP($JOB,LIST,+PSS(1),.01)=$PIECE(PSSZNODE,"^")
+4 SET ^TMP($JOB,LIST,"B",$PIECE(PSSZNODE,"^"),+PSS(1))=""
+5 NEW PSSCLZAR
DO GETS^DIQ(50,+PSS(1),"17.2","IE","PSSCLZAR")
+6 SET ^TMP($JOB,LIST,+PSS(1),17.2)=$SELECT($GET(PSSCLZAR(50,+PSS(1)_",",17.2,"I"))="":"",1:$GET(PSSCLZAR(50,+PSS(1)_",",17.2,"I"))_"^"_$GET(PSSCLZAR(50,+PSS(1)_",",17.2,"E")))
+7 SET ^TMP($JOB,LIST,+PSS(1),17.5)=$PIECE(PSS50CL1,"^")
+8 SET ^TMP($JOB,LIST,+PSS(1),31)=$PIECE(PSS50CL2,"^",4)
+9 QUIT
SETZRO ;
+1 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),.01,"I"))
+2 SET ^TMP($JOB,LIST,"B",$GET(^TMP("PSSP50",$JOB,50,PSS(1),.01,"I")),+PSS(1))=""
+3 SET ^TMP($JOB,LIST,+PSS(1),2)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),2,"I"))
+4 SET ^TMP($JOB,LIST,+PSS(1),3)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),3,"I"))
+5 SET ^TMP($JOB,LIST,+PSS(1),4)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),4,"I"))
+6 SET ^TMP($JOB,LIST,+PSS(1),5)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),5,"I"))
+7 SET ^TMP($JOB,LIST,+PSS(1),6)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),6,"I"))
+8 SET ^TMP($JOB,LIST,+PSS(1),8)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),8,"I"))
+9 SET ^TMP($JOB,LIST,+PSS(1),51)=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),51,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),51,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50,PSS(1),51,"E")))
+10 SET ^TMP($JOB,LIST,+PSS(1),52)=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),52,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),52,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50,PSS(1),52,"E")))
+11 SET ^TMP($JOB,LIST,+PSS(1),101)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),101,"I"))
+12 QUIT
LOOPZR ;
+1 NEW PSS50DD7,PSS50DD8,PSS50ER7,PSS50ER8,PSS51NFD,PSS52NFD
+2 DO FIELD^DID(50,51,"Z","POINTER","PSS50DD7","PSS50ER7")
SET PSS51NFD=$GET(PSS50DD7("POINTER"))
+3 DO FIELD^DID(50,52,"Z","POINTER","PSS50DD8","PSS50ER8")
SET PSS52NFD=$GET(PSS50DD8("POINTER"))
+4 NEW PSSENCT
+5 SET PSSENCT=0
+6 SET PSS(1)=0
FOR
SET PSS(1)=$ORDER(^PSDRUG(PSS(1)))
if 'PSS(1)
QUIT
Begin DoDot:1
+7 IF $PIECE($GET(^PSDRUG(PSS(1),0)),"^")=""
QUIT
+8 IF $GET(PSSFL)
IF $PIECE($GET(^PSDRUG(PSS(1),"I")),"^")
IF $PIECE($GET(^("I")),"^")'>PSSFL
QUIT
+9 IF $GET(PSSRTOI)=1
IF '$PIECE($GET(^PSDRUG(PSS(1),2)),"^")
QUIT
+10 ;Naked reference below refers to ^PSDRUG(PSS(1),2)
+11 IF $GET(PSSPK)]""
NEW PSSZ5,PSSZ6
SET PSSZ5=0
FOR PSSZ6=1:1:$LENGTH(PSSPK)
if PSSZ5
QUIT
IF $PIECE($GET(^(2)),"^",3)[$EXTRACT(PSSPK,PSSZ6)
SET PSSZ5=1
+12 IF $GET(PSSPK)]""
IF 'PSSZ5
QUIT
+13 DO LOOPZRD
+14 SET PSSENCT=PSSENCT+1
End DoDot:1
+15 SET ^TMP($JOB,LIST,0)=$SELECT($GET(PSSENCT):$GET(PSSENCT),1:"-1^NO DATA FOUND")
+16 QUIT
LOOPZRD ;
+1 NEW PSSZNODE
+2 SET PSSZNODE=$GET(^PSDRUG(PSS(1),0))
+3 SET ^TMP($JOB,LIST,+PSS(1),.01)=$PIECE(PSSZNODE,"^")
+4 SET ^TMP($JOB,LIST,"B",$PIECE(PSSZNODE,"^"),+PSS(1))=""
+5 SET ^TMP($JOB,LIST,+PSS(1),2)=$PIECE(PSSZNODE,"^",2)
+6 SET ^TMP($JOB,LIST,+PSS(1),3)=$PIECE(PSSZNODE,"^",3)
+7 SET ^TMP($JOB,LIST,+PSS(1),4)=$PIECE(PSSZNODE,"^",4)
+8 SET ^TMP($JOB,LIST,+PSS(1),5)=$PIECE(PSSZNODE,"^",5)
+9 SET ^TMP($JOB,LIST,+PSS(1),6)=$PIECE(PSSZNODE,"^",6)
+10 SET ^TMP($JOB,LIST,+PSS(1),8)=$PIECE(PSSZNODE,"^",8)
+11 NEW PSS51NF
SET PSS51NF=$PIECE(PSSZNODE,"^",9)
Begin DoDot:1
+12 IF PSS51NF'=""
IF PSS51NFD'=""
IF PSS51NFD[(PSS51NF_":")
SET ^TMP($JOB,LIST,+PSS(1),51)=PSS51NF_"^"_$PIECE($EXTRACT(PSS51NFD,$FIND(PSS51NFD,(PSS51NF_":")),999),";")
QUIT
+13 SET ^TMP($JOB,LIST,+PSS(1),51)=""
End DoDot:1
+14 NEW PSS52NF
SET PSS52NF=$PIECE(PSSZNODE,"^",11)
Begin DoDot:1
+15 IF PSS52NF'=""
IF PSS52NFD'=""
IF PSS52NFD[(PSS52NF_":")
SET ^TMP($JOB,LIST,+PSS(1),52)=PSS52NF_"^"_$PIECE($EXTRACT(PSS52NFD,$FIND(PSS52NFD,(PSS52NF_":")),999),";")
QUIT
+16 SET ^TMP($JOB,LIST,+PSS(1),52)=""
End DoDot:1
+17 SET ^TMP($JOB,LIST,+PSS(1),101)=$PIECE(PSSZNODE,"^",10)
+18 QUIT
LOOPB ;
+1 NEW PSSENCT,PSSZNAM
+2 SET PSSENCT=0
+3 SET PSS(1)=0
FOR
SET PSS(1)=$ORDER(^PSDRUG(PSS(1)))
if 'PSS(1)
QUIT
Begin DoDot:1
+4 SET PSSZNAM=$PIECE($GET(^PSDRUG(PSS(1),0)),"^")
+5 IF PSSZNAM=""
QUIT
+6 IF $GET(PSSFL)
IF $PIECE($GET(^PSDRUG(PSS(1),"I")),"^")
IF $PIECE($GET(^("I")),"^")'>PSSFL
QUIT
+7 IF $GET(PSSRTOI)=1
IF '$PIECE($GET(^PSDRUG(PSS(1),2)),"^")
QUIT
+8 ;Naked reference below refers to ^PSDRUG(PSS(1),2)
+9 IF $GET(PSSPK)]""
NEW PSSZ5,PSSZ6
SET PSSZ5=0
FOR PSSZ6=1:1:$LENGTH(PSSPK)
if PSSZ5
QUIT
IF $PIECE($GET(^(2)),"^",3)[$EXTRACT(PSSPK,PSSZ6)
SET PSSZ5=1
+10 IF $GET(PSSPK)]""
IF 'PSSZ5
QUIT
+11 SET ^TMP($JOB,LIST,+PSS(1),.01)=PSSZNAM
+12 SET ^TMP($JOB,LIST,"B",PSSZNAM,+PSS(1))=""
+13 SET PSSENCT=PSSENCT+1
End DoDot:1
+14 SET ^TMP($JOB,LIST,0)=$SELECT($GET(PSSENCT):$GET(PSSENCT),1:"-1^NO DATA FOUND")
+15 QUIT
CSYN ;
+1 ;PSSIEN = internal entry number from Drug (#50) file
+2 ;PSSVAL = Synonym name
+3 ;LIST = Global return subscript
+4 IF $GET(LIST)']""
QUIT
+5 KILL ^TMP($JOB,LIST)
+6 IF '$GET(PSSIEN)!($GET(PSSVAL)="")
SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"
QUIT
+7 NEW PSSCSNAM,PSSCSX,PSSCSSYN
+8 SET PSSCSNAM=$PIECE($GET(^PSDRUG(PSSIEN,0)),"^")
IF PSSCSNAM=""
SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"
QUIT
+9 SET PSSCSX=$ORDER(^PSDRUG("C",PSSVAL,PSSIEN,""))
IF 'PSSCSX
SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"
QUIT
+10 SET PSSCSSYN=$PIECE($GET(^PSDRUG(PSSIEN,1,PSSCSX,0)),"^")
IF PSSCSSYN=""
SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"
QUIT
+11 SET ^TMP($JOB,LIST,PSSIEN,.01)=PSSCSNAM
+12 SET ^TMP($JOB,LIST,PSSIEN,"SYN",0)=1
+13 SET ^TMP($JOB,LIST,PSSIEN,"SYN",PSSCSX,.01)=PSSCSSYN
+14 SET ^TMP($JOB,LIST,PSSIEN,"SYN",PSSCSX,403)=$PIECE($GET(^PSDRUG(PSSIEN,1,PSSCSX,0)),"^",7)
+15 SET ^TMP($JOB,LIST,"C",PSSCSSYN,PSSIEN)=""
+16 SET ^TMP($JOB,LIST,0)=1
+17 QUIT
DSPUNT ;
+1 ;PSSIEN = internal entry number from Drug (#50) file
+2 ;PSSIEN2 = internal entry from the Synonym multiple
+3 ;LIST = Global return subscript
+4 IF $GET(LIST)']""
QUIT
+5 KILL ^TMP($JOB,LIST)
+6 IF +$GET(PSSIEN)'>0!(+$GET(PSSIEN2)'>0)
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+7 NEW PSSDSNAM,PSSDSX,PSSDSSYN
+8 SET PSSDSNAM=$PIECE($GET(^PSDRUG(PSSIEN,0)),"^")
IF PSSDSNAM=""
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+9 SET PSSDSSYN=$PIECE($GET(^PSDRUG(PSSIEN,1,PSSIEN2,0)),"^")
IF PSSDSSYN=""
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+10 SET ^TMP($JOB,LIST,PSSIEN,.01)=PSSDSNAM
+11 SET ^TMP($JOB,LIST,PSSIEN,"SYN",0)=1
+12 SET ^TMP($JOB,LIST,PSSIEN,"SYN",PSSIEN2,.01)=PSSDSSYN
+13 SET ^TMP($JOB,LIST,PSSIEN,"SYN",PSSIEN2,403)=$PIECE($GET(^PSDRUG(PSSIEN,1,PSSIEN2,0)),"^",7)
+14 SET ^TMP($JOB,LIST,"C",PSSDSSYN,PSSIEN)=""
+15 SET ^TMP($JOB,LIST,0)=1
+16 QUIT
+17 ;
SETSCRN ;Set Screen
+1 IF +$GET(PSSFL)>0
Begin DoDot:1
+2 ;Naked reference below refers to ^PSDRUG(+Y,"I")
+3 IF SCR("S")]""
SET SCR("S")=SCR("S")_" S PSS5ND=$P($G(^(""I"")),""^"") I PSS5ND=""""!(PSS5ND>PSSFL)"
QUIT
+4 ;Naked reference below refers to ^PSDRUG(+Y,"I")
+5 SET SCR("S")="S PSS5ND=$P($G(^(""I"")),""^"") I PSS5ND=""""!(PSS5ND>PSSFL)"
End DoDot:1
+6 IF $GET(PSSRTOI)=1
Begin DoDot:1
+7 ;Naked reference below refers to ^PSDRUG(+Y,2)
+8 IF SCR("S")]""
SET SCR("S")=SCR("S")_" I $P($G(^(2)),""^"")"
QUIT
+9 ;Naked reference below refers to ^PSDRUG(+Y,2)
+10 SET SCR("S")="I $P($G(^(2)),""^"")"
End DoDot:1
+11 IF $GET(PSSPK)]""
Begin DoDot:1
+12 ;Naked reference below refers to ^PSDRUG(+Y,2)
+13 IF SCR("S")]""
SET 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"
QUIT
+14 ;Naked reference below refers to ^PSDRUG(+Y,2)
+15 SET SCR("S")="S PSSZ3=0 F PSSZ4=1:1:$L(PSSPK) Q:PSSZ3 I $P($G(^(2)),""^"",3)[$E(PSSPK,PSSZ4) S PSSZ3=1"
End DoDot:1
+16 ;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")
+17 QUIT
