PSS50NDF ;BIR/LDT - CONTINUATION OF API FOR INFORMATION FROM FILE 50; 5 Sep 03
;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
;External reference to PS(50.605 supported by DBIA 2138
;
SETND ;
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),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),23)=$S($G(^TMP("PSSP50",$J,50,PSS(1),23,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),23,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),23,"E")))
S ^TMP($J,LIST,+PSS(1),24)=$S($G(^TMP("PSSP50",$J,50,PSS(1),24,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),24,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),24,"E")))
N PSS50NCL S PSS50NCL=$S($G(^TMP("PSSP50",$J,50,PSS(1),25,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),25,"I")))
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")))
I PSS50NCL S ^TMP($J,LIST,+PSS(1),25)=^TMP($J,LIST,+PSS(1),25)_"^"_$P($G(^PS(50.605,PSS50NCL,0)),"^",2)
S ^TMP($J,LIST,+PSS(1),27)=$G(^TMP("PSSP50",$J,50,PSS(1),27,"I"))
S ^TMP($J,LIST,+PSS(1),29)=$S($G(^TMP("PSSP50",$J,50,PSS(1),29,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),29,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),29,"E")))
Q
LOOP ;
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 SETNDL
.S PSSENCT=PSSENCT+1
S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
Q
SETNDL ;
N PSSZNODE,PSS50NDN
S PSSZNODE=$G(^PSDRUG(PSS(1),0)),PSS50NDN=$G(^("ND"))
S ^TMP($J,LIST,+PSS(1),.01)=$P(PSSZNODE,"^")
S ^TMP($J,LIST,"B",$P(PSSZNODE,"^"),+PSS(1))=""
N PSS50NDA D GETS^DIQ(50,+PSS(1),"20;21;22;23;24;25;27;29","IE","PSS50NDA")
S ^TMP($J,LIST,+PSS(1),20)=$S($G(PSS50NDA(50,+PSS(1)_",",20,"I"))="":"",1:$G(PSS50NDA(50,+PSS(1)_",",20,"I"))_"^"_$G(PSS50NDA(50,+PSS(1)_",",20,"E")))
S ^TMP($J,LIST,+PSS(1),21)=$G(PSS50NDA(50,+PSS(1)_",",21,"I"))
S ^TMP($J,LIST,+PSS(1),22)=$S($G(PSS50NDA(50,+PSS(1)_",",22,"I"))="":"",1:$G(PSS50NDA(50,+PSS(1)_",",22,"I"))_"^"_$G(PSS50NDA(50,+PSS(1)_",",22,"E")))
S ^TMP($J,LIST,+PSS(1),23)=$S($G(PSS50NDA(50,+PSS(1)_",",23,"I"))="":"",1:$G(PSS50NDA(50,+PSS(1)_",",23,"I"))_"^"_$G(PSS50NDA(50,+PSS(1)_",",23,"E")))
S ^TMP($J,LIST,+PSS(1),24)=$S($G(PSS50NDA(50,+PSS(1)_",",24,"I"))="":"",1:$G(PSS50NDA(50,+PSS(1)_",",24,"I"))_"^"_$G(PSS50NDA(50,+PSS(1)_",",24,"E")))
N PSS50NLL S PSS50NLL=$S($G(PSS50NDA(50,+PSS(1)_",",25,"I"))="":"",1:$G(PSS50NDA(50,+PSS(1)_",",25,"I")))
S ^TMP($J,LIST,+PSS(1),25)=$S($G(PSS50NDA(50,+PSS(1)_",",25,"I"))="":"",1:$G(PSS50NDA(50,+PSS(1)_",",25,"I"))_"^"_$G(PSS50NDA(50,+PSS(1)_",",25,"E")))
I PSS50NLL S ^TMP($J,LIST,+PSS(1),25)=^TMP($J,LIST,+PSS(1),25)_"^"_$P($G(^PS(50.605,PSS50NLL,0)),"^",2)
S ^TMP($J,LIST,+PSS(1),27)=$G(PSS50NDA(50,+PSS(1)_",",27,"I"))
S ^TMP($J,LIST,+PSS(1),29)=$S($G(PSS50NDA(50,+PSS(1)_",",29,"I"))="":"",1:$G(PSS50NDA(50,+PSS(1)_",",29,"I"))_"^"_$G(PSS50NDA(50,+PSS(1)_",",29,"E")))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS50NDF 3771 printed Oct 16, 2024@18:30:39 Page 2
PSS50NDF ;BIR/LDT - CONTINUATION OF API FOR INFORMATION FROM FILE 50; 5 Sep 03
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
+2 ;External reference to PS(50.605 supported by DBIA 2138
+3 ;
SETND ;
+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),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")))
+4 SET ^TMP($JOB,LIST,+PSS(1),21)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),21,"I"))
+5 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")))
+6 SET ^TMP($JOB,LIST,+PSS(1),23)=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),23,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),23,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50,PSS(1),23,"E")))
+7 SET ^TMP($JOB,LIST,+PSS(1),24)=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),24,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),24,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50,PSS(1),24,"E")))
+8 NEW PSS50NCL
SET PSS50NCL=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),25,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),25,"I")))
+9 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")))
+10 IF PSS50NCL
SET ^TMP($JOB,LIST,+PSS(1),25)=^TMP($JOB,LIST,+PSS(1),25)_"^"_$PIECE($GET(^PS(50.605,PSS50NCL,0)),"^",2)
+11 SET ^TMP($JOB,LIST,+PSS(1),27)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),27,"I"))
+12 SET ^TMP($JOB,LIST,+PSS(1),29)=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),29,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),29,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50,PSS(1),29,"E")))
+13 QUIT
LOOP ;
+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 SETNDL
+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
SETNDL ;
+1 NEW PSSZNODE,PSS50NDN
+2 SET PSSZNODE=$GET(^PSDRUG(PSS(1),0))
SET PSS50NDN=$GET(^("ND"))
+3 SET ^TMP($JOB,LIST,+PSS(1),.01)=$PIECE(PSSZNODE,"^")
+4 SET ^TMP($JOB,LIST,"B",$PIECE(PSSZNODE,"^"),+PSS(1))=""
+5 NEW PSS50NDA
DO GETS^DIQ(50,+PSS(1),"20;21;22;23;24;25;27;29","IE","PSS50NDA")
+6 SET ^TMP($JOB,LIST,+PSS(1),20)=$SELECT($GET(PSS50NDA(50,+PSS(1)_",",20,"I"))="":"",1:$GET(PSS50NDA(50,+PSS(1)_",",20,"I"))_"^"_$GET(PSS50NDA(50,+PSS(1)_",",20,"E")))
+7 SET ^TMP($JOB,LIST,+PSS(1),21)=$GET(PSS50NDA(50,+PSS(1)_",",21,"I"))
+8 SET ^TMP($JOB,LIST,+PSS(1),22)=$SELECT($GET(PSS50NDA(50,+PSS(1)_",",22,"I"))="":"",1:$GET(PSS50NDA(50,+PSS(1)_",",22,"I"))_"^"_$GET(PSS50NDA(50,+PSS(1)_",",22,"E")))
+9 SET ^TMP($JOB,LIST,+PSS(1),23)=$SELECT($GET(PSS50NDA(50,+PSS(1)_",",23,"I"))="":"",1:$GET(PSS50NDA(50,+PSS(1)_",",23,"I"))_"^"_$GET(PSS50NDA(50,+PSS(1)_",",23,"E")))
+10 SET ^TMP($JOB,LIST,+PSS(1),24)=$SELECT($GET(PSS50NDA(50,+PSS(1)_",",24,"I"))="":"",1:$GET(PSS50NDA(50,+PSS(1)_",",24,"I"))_"^"_$GET(PSS50NDA(50,+PSS(1)_",",24,"E")))
+11 NEW PSS50NLL
SET PSS50NLL=$SELECT($GET(PSS50NDA(50,+PSS(1)_",",25,"I"))="":"",1:$GET(PSS50NDA(50,+PSS(1)_",",25,"I")))
+12 SET ^TMP($JOB,LIST,+PSS(1),25)=$SELECT($GET(PSS50NDA(50,+PSS(1)_",",25,"I"))="":"",1:$GET(PSS50NDA(50,+PSS(1)_",",25,"I"))_"^"_$GET(PSS50NDA(50,+PSS(1)_",",25,"E")))
+13 IF PSS50NLL
SET ^TMP($JOB,LIST,+PSS(1),25)=^TMP($JOB,LIST,+PSS(1),25)_"^"_$PIECE($GET(^PS(50.605,PSS50NLL,0)),"^",2)
+14 SET ^TMP($JOB,LIST,+PSS(1),27)=$GET(PSS50NDA(50,+PSS(1)_",",27,"I"))
+15 SET ^TMP($JOB,LIST,+PSS(1),29)=$SELECT($GET(PSS50NDA(50,+PSS(1)_",",29,"I"))="":"",1:$GET(PSS50NDA(50,+PSS(1)_",",29,"I"))_"^"_$GET(PSS50NDA(50,+PSS(1)_",",29,"E")))
+16 QUIT
