PSS50WS ;BIR/LDT - API FOR INFORMATION FROM FILE 50; 5 Sep 03
;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
;
;Reference to ^PS(50.605 is supported by DBIA #2138
;Reference to ^PS(50.609 supported by DBIA #2137
;External reference to PSNDF(50.6 supported by DBIA #2079
;Reference to ^PSNDF(50.68 supported by DBIA #3735
;
ARWS ;
;PSSIEN - IEN of entry in 50
;PSSFT - Free Text name in 50
;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
; piece being returned.
;Returns PSG node of 50
N DIERR,ZZERR,PSS50,PSSP50,PSS,SCR,PSSMLCT
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(50,"","A","`"_PSSIEN,,,"") D K ^TMP("PSSP50",$J) Q
.K ^TMP("DIERR",$J)
.I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
.S ^TMP($J,LIST,0)=1
.K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN2,".01;2;3;12:16;20:25;31;51;52;301;302","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
.F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SETWS
I $G(PSSIEN)'="" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
I $G(PSSFT)]"" D
.I PSSFT["??" D LOOP Q
.K ^TMP("DILIST",$J)
.D FIND^DIC(50,,"@;.01","QP",PSSFT,,"B",,,"")
.I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
.I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0)
..K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN,".01;2;3;12:16;20:25;31;51;52;301;302","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
..F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SETWS
K ^TMP("DILIST",$J),^TMP("PSSP50",$J)
Q
;
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),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"))
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),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),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),31)=$G(^TMP("PSSP50",$J,50,PSS(1),31,"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),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 PSS50D13,PSS50D14,PSS50D15,PSS50E13,PSS50E14,PSS50E15,PSS51NFD,PSS52NFD,PSSG2N
D FIELD^DID(50,51,"Z","POINTER","PSS50D13","PSS50E13") S PSS51NFD=$G(PSS50D13("POINTER"))
D FIELD^DID(50,52,"Z","POINTER","PSS50D14","PSS50E14") S PSS52NFD=$G(PSS50D14("POINTER"))
D FIELD^DID(50,301,"Z","POINTER","PSS50D15","PSS50E15") S PSSG2N=$G(PSS50D15("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 SETWSLP
.S PSSENCT=PSSENCT+1
S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
Q
;
SETWSLP ;
N PSSZNODE,PSS660,PSSNDNOD,PSS2NODE,PSSG2NOD S PSSZNODE=$G(^PSDRUG(PSS(1),0)),PSS2NODE=$G(^(2)),PSS660=$G(^(660)),PSSG2NOD=$G(^("PSG")),PSSNDNOD=$G(^("ND"))
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),12)=$S($P(PSS660,"^",2):$P(PSS660,"^",2)_"^"_$P($G(^DIC(51.5,+$P(PSS660,"^",2),0)),"^")_"^"_$P($G(^(0)),"^",2),1:"")
S ^TMP($J,LIST,+PSS(1),13)=$P(PSS660,"^",3)
S ^TMP($J,LIST,+PSS(1),14.5)=$P(PSS660,"^",8)
S ^TMP($J,LIST,+PSS(1),15)=$P(PSS660,"^",5)
S ^TMP($J,LIST,+PSS(1),16)=$P(PSS660,"^",6)
S ^TMP($J,LIST,+PSS(1),20)=$S($P(PSSNDNOD,"^"):$P(PSSNDNOD,"^")_"^"_$P($G(^PSNDF(50.6,+$P(PSSNDNOD,"^"),0)),"^"),1:"")
S ^TMP($J,LIST,+PSS(1),21)=$P(PSSNDNOD,"^",2)
S ^TMP($J,LIST,+PSS(1),22)=$S($P(PSSNDNOD,"^",3):$P(PSSNDNOD,"^",3)_"^"_$P($G(^PSNDF(50.68,+$P(PSSNDNOD,"^",3),0)),"^"),1:"")
S ^TMP($J,LIST,+PSS(1),23)=$S($P(PSSNDNOD,"^",4):$P(PSSNDNOD,"^",4)_"^"_$P($G(^PS(50.609,+$P(PSSNDNOD,"^",4),0)),"^"),1:"")
S ^TMP($J,LIST,+PSS(1),25)=$S($P(PSSNDNOD,"^",6):$P(PSSNDNOD,"^",6)_"^"_$P($G(^PS(50.605,+$P(PSSNDNOD,"^",6),0)),"^")_"^"_$P($G(^(0)),"^",2),1:"")
S ^TMP($J,LIST,+PSS(1),31)=$P(PSS2NODE,"^",4)
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)=""
N PSSG2 S PSSG2=$P(PSSG2NOD,"^",2) D
.I PSSG2'="",PSSG2N'="",PSSG2N[(PSSG2_":") S ^TMP($J,LIST,+PSS(1),301)=PSSG2_"^"_$P($E(PSSG2N,$F(PSSG2N,(PSSG2_":")),999),";") Q
.S ^TMP($J,LIST,+PSS(1),301)=""
S ^TMP($J,LIST,+PSS(1),302)=$P(PSSG2NOD,"^",3)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS50WS 7040 printed Oct 16, 2024@18:30:45 Page 2
PSS50WS ;BIR/LDT - API FOR INFORMATION FROM FILE 50; 5 Sep 03
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
+2 ;
+3 ;Reference to ^PS(50.605 is supported by DBIA #2138
+4 ;Reference to ^PS(50.609 supported by DBIA #2137
+5 ;External reference to PSNDF(50.6 supported by DBIA #2079
+6 ;Reference to ^PSNDF(50.68 supported by DBIA #3735
+7 ;
ARWS ;
+1 ;PSSIEN - IEN of entry in 50
+2 ;PSSFT - Free Text name in 50
+3 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
+4 ; piece being returned.
+5 ;Returns PSG node of 50
+6 NEW DIERR,ZZERR,PSS50,PSSP50,PSS,SCR,PSSMLCT
+7 IF $GET(LIST)']""
QUIT
+8 KILL ^TMP($JOB,LIST)
+9 IF +$GET(PSSIEN)'>0
IF ($GET(PSSFT)']"")
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+10 IF +$GET(PSSIEN)>0
NEW PSSIEN2
SET PSSIEN2=$$FIND1^DIC(50,"","A","`"_PSSIEN,,,"")
Begin DoDot:1
+11 KILL ^TMP("DIERR",$JOB)
+12 IF +PSSIEN2'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+13 SET ^TMP($JOB,LIST,0)=1
+14 KILL ^TMP("PSSP50",$JOB)
DO GETS^DIQ(50,+PSSIEN2,".01;2;3;12:16;20:25;31;51;52;301;302","IE","^TMP(""PSSP50"",$J)")
SET PSS(1)=0
+15 FOR
SET PSS(1)=$ORDER(^TMP("PSSP50",$JOB,50,PSS(1)))
if 'PSS(1)
QUIT
DO SETWS
End DoDot:1
KILL ^TMP("PSSP50",$JOB)
QUIT
+16 IF $GET(PSSIEN)'=""
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+17 IF $GET(PSSFT)]""
Begin DoDot:1
+18 IF PSSFT["??"
DO LOOP
QUIT
+19 KILL ^TMP("DILIST",$JOB)
+20 DO FIND^DIC(50,,"@;.01","QP",PSSFT,,"B",,,"")
+21 IF +$GET(^TMP("DILIST",$JOB,0))=0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+22 IF +^TMP("DILIST",$JOB,0)>0
SET ^TMP($JOB,LIST,0)=+^TMP("DILIST",$JOB,0)
NEW PSSXX
SET PSSXX=0
FOR
SET PSSXX=$ORDER(^TMP("DILIST",$JOB,PSSXX))
if 'PSSXX
QUIT
Begin DoDot:2
+23 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
+24 KILL ^TMP("PSSP50",$JOB)
DO GETS^DIQ(50,+PSSIEN,".01;2;3;12:16;20:25;31;51;52;301;302","IE","^TMP(""PSSP50"",$J)")
SET PSS(1)=0
+25 FOR
SET PSS(1)=$ORDER(^TMP("PSSP50",$JOB,50,PSS(1)))
if 'PSS(1)
QUIT
DO SETWS
End DoDot:2
End DoDot:1
+26 KILL ^TMP("DILIST",$JOB),^TMP("PSSP50",$JOB)
+27 QUIT
+28 ;
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 ;
+4 ;
+5 SET ^TMP($JOB,LIST,+PSS(1),2)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),2,"I"))
+6 SET ^TMP($JOB,LIST,+PSS(1),3)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),3,"I"))
+7 NEW PSSUTN
SET PSSUTN=$GET(^TMP("PSSP50",$JOB,50,PSS(1),12,"I"))
+8 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")))
+9 IF PSSUTN'=""
SET ^TMP($JOB,LIST,+PSS(1),12)=^TMP($JOB,LIST,+PSS(1),12)_"^"_$PIECE($GET(^DIC(51.5,PSSUTN,0)),"^",2)
+10 SET ^TMP($JOB,LIST,+PSS(1),13)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),13,"I"))
+11 SET ^TMP($JOB,LIST,+PSS(1),14.5)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),14.5,"I"))
+12 SET ^TMP($JOB,LIST,+PSS(1),15)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),15,"I"))
+13 SET ^TMP($JOB,LIST,+PSS(1),16)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),16,"I"))
+14 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")))
+15 SET ^TMP($JOB,LIST,+PSS(1),21)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),21,"I"))
+16 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")))
+17 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")))
+18 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))
+19 SET ^TMP($JOB,LIST,+PSS(1),31)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),31,"I"))
+20 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")))
+21 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")))
+22 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")))
+23 SET ^TMP($JOB,LIST,+PSS(1),302)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),302,"I"))
+24 QUIT
LOOP ;
+1 NEW PSS50D13,PSS50D14,PSS50D15,PSS50E13,PSS50E14,PSS50E15,PSS51NFD,PSS52NFD,PSSG2N
+2 DO FIELD^DID(50,51,"Z","POINTER","PSS50D13","PSS50E13")
SET PSS51NFD=$GET(PSS50D13("POINTER"))
+3 DO FIELD^DID(50,52,"Z","POINTER","PSS50D14","PSS50E14")
SET PSS52NFD=$GET(PSS50D14("POINTER"))
+4 DO FIELD^DID(50,301,"Z","POINTER","PSS50D15","PSS50E15")
SET PSSG2N=$GET(PSS50D15("POINTER"))
+5 NEW PSSENCT
+6 SET PSSENCT=0
+7 SET PSS(1)=0
FOR
SET PSS(1)=$ORDER(^PSDRUG(PSS(1)))
if 'PSS(1)
QUIT
Begin DoDot:1
+8 IF $PIECE($GET(^PSDRUG(PSS(1),0)),"^")=""
QUIT
+9 IF $GET(PSSFL)
IF $PIECE($GET(^PSDRUG(PSS(1),"I")),"^")
IF $PIECE($GET(^("I")),"^")'>PSSFL
QUIT
+10 IF $GET(PSSRTOI)=1
IF '$PIECE($GET(^PSDRUG(PSS(1),2)),"^")
QUIT
+11 ;Naked reference below refers to ^PSDRUG(PSS(1),2)
+12 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
+13 IF $GET(PSSPK)]""
IF 'PSSZ5
QUIT
+14 DO SETWSLP
+15 SET PSSENCT=PSSENCT+1
End DoDot:1
+16 SET ^TMP($JOB,LIST,0)=$SELECT($GET(PSSENCT):$GET(PSSENCT),1:"-1^NO DATA FOUND")
+17 QUIT
+18 ;
SETWSLP ;
+1 NEW PSSZNODE,PSS660,PSSNDNOD,PSS2NODE,PSSG2NOD
SET PSSZNODE=$GET(^PSDRUG(PSS(1),0))
SET PSS2NODE=$GET(^(2))
SET PSS660=$GET(^(660))
SET PSSG2NOD=$GET(^("PSG"))
SET PSSNDNOD=$GET(^("ND"))
+2 SET ^TMP($JOB,LIST,+PSS(1),.01)=$PIECE(PSSZNODE,"^")
+3 SET ^TMP($JOB,LIST,"B",$PIECE(PSSZNODE,"^"),+PSS(1))=""
+4 SET ^TMP($JOB,LIST,+PSS(1),2)=$PIECE(PSSZNODE,"^",2)
+5 SET ^TMP($JOB,LIST,+PSS(1),3)=$PIECE(PSSZNODE,"^",3)
+6 SET ^TMP($JOB,LIST,+PSS(1),12)=$SELECT($PIECE(PSS660,"^",2):$PIECE(PSS660,"^",2)_"^"_$PIECE($GET(^DIC(51.5,+$PIECE(PSS660,"^",2),0)),"^")_"^"_$PIECE($GET(^(0)),"^",2),1:"")
+7 SET ^TMP($JOB,LIST,+PSS(1),13)=$PIECE(PSS660,"^",3)
+8 SET ^TMP($JOB,LIST,+PSS(1),14.5)=$PIECE(PSS660,"^",8)
+9 SET ^TMP($JOB,LIST,+PSS(1),15)=$PIECE(PSS660,"^",5)
+10 SET ^TMP($JOB,LIST,+PSS(1),16)=$PIECE(PSS660,"^",6)
+11 SET ^TMP($JOB,LIST,+PSS(1),20)=$SELECT($PIECE(PSSNDNOD,"^"):$PIECE(PSSNDNOD,"^")_"^"_$PIECE($GET(^PSNDF(50.6,+$PIECE(PSSNDNOD,"^"),0)),"^"),1:"")
+12 SET ^TMP($JOB,LIST,+PSS(1),21)=$PIECE(PSSNDNOD,"^",2)
+13 SET ^TMP($JOB,LIST,+PSS(1),22)=$SELECT($PIECE(PSSNDNOD,"^",3):$PIECE(PSSNDNOD,"^",3)_"^"_$PIECE($GET(^PSNDF(50.68,+$PIECE(PSSNDNOD,"^",3),0)),"^"),1:"")
+14 SET ^TMP($JOB,LIST,+PSS(1),23)=$SELECT($PIECE(PSSNDNOD,"^",4):$PIECE(PSSNDNOD,"^",4)_"^"_$PIECE($GET(^PS(50.609,+$PIECE(PSSNDNOD,"^",4),0)),"^"),1:"")
+15 SET ^TMP($JOB,LIST,+PSS(1),25)=$SELECT($PIECE(PSSNDNOD,"^",6):$PIECE(PSSNDNOD,"^",6)_"^"_$PIECE($GET(^PS(50.605,+$PIECE(PSSNDNOD,"^",6),0)),"^")_"^"_$PIECE($GET(^(0)),"^",2),1:"")
+16 SET ^TMP($JOB,LIST,+PSS(1),31)=$PIECE(PSS2NODE,"^",4)
+17 NEW PSS51NF
SET PSS51NF=$PIECE(PSSZNODE,"^",9)
Begin DoDot:1
+18 IF PSS51NF'=""
IF PSS51NFD'=""
IF PSS51NFD[(PSS51NF_":")
SET ^TMP($JOB,LIST,+PSS(1),51)=PSS51NF_"^"_$PIECE($EXTRACT(PSS51NFD,$FIND(PSS51NFD,(PSS51NF_":")),999),";")
QUIT
+19 SET ^TMP($JOB,LIST,+PSS(1),51)=""
End DoDot:1
+20 NEW PSS52NF
SET PSS52NF=$PIECE(PSSZNODE,"^",11)
Begin DoDot:1
+21 IF PSS52NF'=""
IF PSS52NFD'=""
IF PSS52NFD[(PSS52NF_":")
SET ^TMP($JOB,LIST,+PSS(1),52)=PSS52NF_"^"_$PIECE($EXTRACT(PSS52NFD,$FIND(PSS52NFD,(PSS52NF_":")),999),";")
QUIT
+22 SET ^TMP($JOB,LIST,+PSS(1),52)=""
End DoDot:1
+23 NEW PSSG2
SET PSSG2=$PIECE(PSSG2NOD,"^",2)
Begin DoDot:1
+24 IF PSSG2'=""
IF PSSG2N'=""
IF PSSG2N[(PSSG2_":")
SET ^TMP($JOB,LIST,+PSS(1),301)=PSSG2_"^"_$PIECE($EXTRACT(PSSG2N,$FIND(PSSG2N,(PSSG2_":")),999),";")
QUIT
+25 SET ^TMP($JOB,LIST,+PSS(1),301)=""
End DoDot:1
+26 SET ^TMP($JOB,LIST,+PSS(1),302)=$PIECE(PSSG2NOD,"^",3)
+27 QUIT
