PSS50A ;BIR/LDT - CONTINUATION OF API FOR INFORMATION FROM FILE 50 ;5 Sep 03
;;1.0;PHARMACY DATA MANAGEMENT;**85,91,92**;9/30/97
;External reference to PS(50.605 supported by DBIA 2138
;
SETSCRN ;Set Screen for inactive Drugs
;Naked reference below refers to ^PSDRUG(+Y,"I")
I +$G(PSSFL)>0 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
;
SETALL ;
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),2.1)=$S($G(^TMP("PSSP50",$J,50,PSS(1),2.1,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),2.1,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),2.1,"E")))
I $P($G(^TMP($J,LIST,+PSS(1),2.1)),"^") D
.N PSSADDF S PSSADDF=$$SETDF^PSS50AQM($P(^TMP($J,LIST,+PSS(1),2.1),"^")) S ^TMP($J,LIST,+PSS(1),2.1)=^TMP($J,LIST,+PSS(1),2.1)_$S($P($G(PSSADDF),"^")>0:"^"_$P($G(PSSADDF),"^",3)_"^"_$P($G(PSSADDF),"^",4),1:"")
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"))
N PSSUTN S PSSUTN=$G(^TMP("PSSP50",$J,50,PSS(1),12,"I"))
S ^TMP($J,LIST,+PSS(1),12)=$S($G(PSSUTN)="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),12,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),12,"E")))
I PSSUTN'="" S ^TMP($J,LIST,+PSS(1),12)=^TMP($J,LIST,+PSS(1),12)_"^"_$P($G(^DIC(51.5,PSSUTN,0)),"^",2)
S ^TMP($J,LIST,+PSS(1),13)=$G(^TMP("PSSP50",$J,50,PSS(1),13,"I"))
S ^TMP($J,LIST,+PSS(1),14.5)=$G(^TMP("PSSP50",$J,50,PSS(1),14.5,"I"))
S ^TMP($J,LIST,+PSS(1),15)=$G(^TMP("PSSP50",$J,50,PSS(1),15,"I"))
S ^TMP($J,LIST,+PSS(1),16)=$G(^TMP("PSSP50",$J,50,PSS(1),16,"I"))
S ^TMP($J,LIST,+PSS(1),20)=$S($G(^TMP("PSSP50",$J,50,PSS(1),20,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),20,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),20,"E")))
S ^TMP($J,LIST,+PSS(1),21)=$G(^TMP("PSSP50",$J,50,PSS(1),21,"I"))
S ^TMP($J,LIST,+PSS(1),22)=$S($G(^TMP("PSSP50",$J,50,PSS(1),22,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),22,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),22,"E")))
S ^TMP($J,LIST,+PSS(1),25)=$S($G(^TMP("PSSP50",$J,50,PSS(1),25,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),25,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),25,"E"))_"^"_$P($G(^PS(50.605,+^TMP("PSSP50",$J,50,PSS(1),25,"I"),0)),"^",2))
S ^TMP($J,LIST,+PSS(1),27)=$G(^TMP("PSSP50",$J,50,PSS(1),27,"I"))
S ^TMP($J,LIST,+PSS(1),31)=$G(^TMP("PSSP50",$J,50,PSS(1),31,"I"))
S ^TMP($J,LIST,+PSS(1),40)=$G(^TMP("PSSP50",$J,50,PSS(1),40,"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),63)=$G(^TMP("PSSP50",$J,50,PSS(1),63,"I"))
S ^TMP($J,LIST,+PSS(1),64)=$S('$P($G(^TMP("PSSP50",$J,50,PSS(1),64,"I")),"^"):"",1:$P($G(^TMP("PSSP50",$J,50,PSS(1),64,"I")),"^")_"^"_$P($G(^TMP("PSSP50",$J,50,PSS(1),64,"E")),"^"))
S ^TMP($J,LIST,+PSS(1),100)=$S($G(^TMP("PSSP50",$J,50,PSS(1),100,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),100,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),100,"E")))
S ^TMP($J,LIST,+PSS(1),101)=$G(^TMP("PSSP50",$J,50,PSS(1),101,"I"))
S ^TMP($J,LIST,+PSS(1),102)=$G(^TMP("PSSP50",$J,50,PSS(1),102,"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"))
D SRVCODE
Q
;
SETSYN ;
S ^TMP($J,LIST,+PSS(1),"SYN",+PSS(2),.01)=$G(^TMP("PSSP50",$J,50.1,PSS(2),.01,"I"))
S ^TMP($J,LIST,+PSS(1),"SYN",+PSS(2),1)=$S($G(^TMP("PSSP50",$J,50.1,PSS(2),1,"I"))="":"",1:^TMP("PSSP50",$J,50.1,PSS(2),1,"I")_"^"_^TMP("PSSP50",$J,50.1,PSS(2),1,"E"))
S ^TMP($J,LIST,+PSS(1),"SYN",+PSS(2),2)=$G(^TMP("PSSP50",$J,50.1,PSS(2),2,"I"))
S ^TMP($J,LIST,+PSS(1),"SYN",+PSS(2),403)=$G(^TMP("PSSP50",$J,50.1,PSS(2),403,"I"))
Q
;
SETFMA ;
S ^TMP($J,LIST,+PSS(1),"FRM",+PSS(2),.01)=$S($G(^TMP("PSSP50",$J,50.065,PSS(2),.01,"I"))="":"",1:^TMP("PSSP50",$J,50.065,PSS(2),.01,"I")_"^"_^TMP("PSSP50",$J,50.065,PSS(2),.01,"E"))
Q
;
SETOLD ;
S ^TMP($J,LIST,+PSS(1),"OLD",+PSS(2),.01)=$G(^TMP("PSSP50",$J,50.01,PSS(2),.01,"I"))
S ^TMP($J,LIST,+PSS(1),"OLD",+PSS(2),.02)=$S($G(^TMP("PSSP50",$J,50.01,PSS(2),.02,"I"))="":"",1:^TMP("PSSP50",$J,50.01,PSS(2),.02,"I")_"^"_^TMP("PSSP50",$J,50.01,PSS(2),.02,"E"))
Q
;
SRVCODE ;
;PFSS retrieve correct service code from file #50.68/#50 or set to 600000
S ^TMP($J,LIST,+PSS(1),400)=$G(^TMP("PSSP50",$J,50,PSS(1),400,"I"))
N PSSNDSC S PSSNDSC=$$GET1^DIQ(50,PSSIEN_",","22:2000","I")
S:PSSNDSC ^TMP($J,LIST,+PSS(1),400)=PSSNDSC
I '+$G(^TMP($J,LIST,+PSS(1),400)) S ^TMP($J,LIST,+PSS(1),400)=600000
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS50A 5913 printed Dec 13, 2024@02:29:40 Page 2
PSS50A ;BIR/LDT - CONTINUATION OF API FOR INFORMATION FROM FILE 50 ;5 Sep 03
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**85,91,92**;9/30/97
+2 ;External reference to PS(50.605 supported by DBIA 2138
+3 ;
SETSCRN ;Set Screen for inactive Drugs
+1 ;Naked reference below refers to ^PSDRUG(+Y,"I")
+2 IF +$GET(PSSFL)>0
SET SCR("S")="S PSS5ND=$P($G(^(""I"")),""^"") I PSS5ND=""""!(PSS5ND>PSSFL)"
+3 IF $GET(PSSRTOI)=1
Begin DoDot:1
+4 ;Naked reference below refers to ^PSDRUG(+Y,2)
+5 IF SCR("S")]""
SET SCR("S")=SCR("S")_" I $P($G(^(2)),""^"")"
QUIT
+6 ;Naked reference below refers to ^PSDRUG(+Y,2)
+7 SET SCR("S")="I $P($G(^(2)),""^"")"
End DoDot:1
+8 IF $GET(PSSPK)]""
Begin DoDot:1
+9 ;Naked reference below refers to ^PSDRUG(+Y,2)
+10 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
+11 ;Naked reference below refers to ^PSDRUG(+Y,2)
+12 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
+13 ;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")
+14 QUIT
+15 ;
SETALL ;
+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),2.1)=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),2.1,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),2.1,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50,PSS(1),2.1,"E")))
+5 IF $PIECE($GET(^TMP($JOB,LIST,+PSS(1),2.1)),"^")
Begin DoDot:1
+6 NEW PSSADDF
SET PSSADDF=$$SETDF^PSS50AQM($PIECE(^TMP($JOB,LIST,+PSS(1),2.1),"^"))
SET ^TMP($JOB,LIST,+PSS(1),2.1)=^TMP($JOB,LIST,+PSS(1),2.1)_$SELECT($PIECE($GET(PSSADDF),"^")>0:"^"_$PIECE($GET(PSSADDF),"^",3)_"^"_$PIECE($GET(PSSADDF),"^",4),1:"")
End DoDot:1
+7 SET ^TMP($JOB,LIST,+PSS(1),3)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),3,"I"))
+8 SET ^TMP($JOB,LIST,+PSS(1),4)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),4,"I"))
+9 SET ^TMP($JOB,LIST,+PSS(1),5)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),5,"I"))
+10 SET ^TMP($JOB,LIST,+PSS(1),6)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),6,"I"))
+11 SET ^TMP($JOB,LIST,+PSS(1),8)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),8,"I"))
+12 NEW PSSUTN
SET PSSUTN=$GET(^TMP("PSSP50",$JOB,50,PSS(1),12,"I"))
+13 SET ^TMP($JOB,LIST,+PSS(1),12)=$SELECT($GET(PSSUTN)="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),12,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50,PSS(1),12,"E")))
+14 IF PSSUTN'=""
SET ^TMP($JOB,LIST,+PSS(1),12)=^TMP($JOB,LIST,+PSS(1),12)_"^"_$PIECE($GET(^DIC(51.5,PSSUTN,0)),"^",2)
+15 SET ^TMP($JOB,LIST,+PSS(1),13)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),13,"I"))
+16 SET ^TMP($JOB,LIST,+PSS(1),14.5)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),14.5,"I"))
+17 SET ^TMP($JOB,LIST,+PSS(1),15)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),15,"I"))
+18 SET ^TMP($JOB,LIST,+PSS(1),16)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),16,"I"))
+19 SET ^TMP($JOB,LIST,+PSS(1),20)=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),20,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),20,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50,PSS(1),20,"E")))
+20 SET ^TMP($JOB,LIST,+PSS(1),21)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),21,"I"))
+21 SET ^TMP($JOB,LIST,+PSS(1),22)=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),22,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),22,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50,PSS(1),22,"E")))
+22 SET ^TMP($JOB,LIST,+PSS(1),25)=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),25,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),25,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50,PSS(1),25,"E"))_"^"_$PIECE(...
... $GET(^PS(50.605,+^TMP("PSSP50",$JOB,50,PSS(1),25,"I"),0)),"^",2))
+23 SET ^TMP($JOB,LIST,+PSS(1),27)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),27,"I"))
+24 SET ^TMP($JOB,LIST,+PSS(1),31)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),31,"I"))
+25 SET ^TMP($JOB,LIST,+PSS(1),40)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),40,"I"))
+26 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")))
+27 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")))
+28 SET ^TMP($JOB,LIST,+PSS(1),63)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),63,"I"))
+29 SET ^TMP($JOB,LIST,+PSS(1),64)=$SELECT('$PIECE($GET(^TMP("PSSP50",$JOB,50,PSS(1),64,"I")),"^"):"",1:$PIECE($GET(^TMP("PSSP50",$JOB,50,PSS(1),64,"I")),"^")_"^"_$PIECE($GET(^TMP("PSSP50",$JOB,50,PSS(1),64,"E")),"^"))
+30 SET ^TMP($JOB,LIST,+PSS(1),100)=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),100,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),100,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50,PSS(1),100,"E")))
+31 SET ^TMP($JOB,LIST,+PSS(1),101)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),101,"I"))
+32 SET ^TMP($JOB,LIST,+PSS(1),102)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),102,"I"))
+33 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")))
+34 SET ^TMP($JOB,LIST,+PSS(1),302)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),302,"I"))
+35 DO SRVCODE
+36 QUIT
+37 ;
SETSYN ;
+1 SET ^TMP($JOB,LIST,+PSS(1),"SYN",+PSS(2),.01)=$GET(^TMP("PSSP50",$JOB,50.1,PSS(2),.01,"I"))
+2 SET ^TMP($JOB,LIST,+PSS(1),"SYN",+PSS(2),1)=$SELECT($GET(^TMP("PSSP50",$JOB,50.1,PSS(2),1,"I"))="":"",1:^TMP("PSSP50",$JOB,50.1,PSS(2),1,"I")_"^"_^TMP("PSSP50",$JOB,50.1,PSS(2),1,"E"))
+3 SET ^TMP($JOB,LIST,+PSS(1),"SYN",+PSS(2),2)=$GET(^TMP("PSSP50",$JOB,50.1,PSS(2),2,"I"))
+4 SET ^TMP($JOB,LIST,+PSS(1),"SYN",+PSS(2),403)=$GET(^TMP("PSSP50",$JOB,50.1,PSS(2),403,"I"))
+5 QUIT
+6 ;
SETFMA ;
+1 SET ^TMP($JOB,LIST,+PSS(1),"FRM",+PSS(2),.01)=$SELECT($GET(^TMP("PSSP50",$JOB,50.065,PSS(2),.01,"I"))="":"",1:^TMP("PSSP50",$JOB,50.065,PSS(2),.01,"I")_"^"_^TMP("PSSP50",$JOB,50.065,PSS(2),.01,"E"))
+2 QUIT
+3 ;
SETOLD ;
+1 SET ^TMP($JOB,LIST,+PSS(1),"OLD",+PSS(2),.01)=$GET(^TMP("PSSP50",$JOB,50.01,PSS(2),.01,"I"))
+2 SET ^TMP($JOB,LIST,+PSS(1),"OLD",+PSS(2),.02)=$SELECT($GET(^TMP("PSSP50",$JOB,50.01,PSS(2),.02,"I"))="":"",1:^TMP("PSSP50",$JOB,50.01,PSS(2),.02,"I")_"^"_^TMP("PSSP50",$JOB,50.01,PSS(2),.02,"E"))
+3 QUIT
+4 ;
SRVCODE ;
+1 ;PFSS retrieve correct service code from file #50.68/#50 or set to 600000
+2 SET ^TMP($JOB,LIST,+PSS(1),400)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),400,"I"))
+3 NEW PSSNDSC
SET PSSNDSC=$$GET1^DIQ(50,PSSIEN_",","22:2000","I")
+4 if PSSNDSC
SET ^TMP($JOB,LIST,+PSS(1),400)=PSSNDSC
+5 IF '+$GET(^TMP($JOB,LIST,+PSS(1),400))
SET ^TMP($JOB,LIST,+PSS(1),400)=600000
+6 QUIT
