PSJMUTL ;BIR/MV - UTLILITY USE FOR QUEUING... ;25 Nov 98 9:13 AM
;;5.0;INPATIENT MEDICATIONS;**8,21,31,160,281**;16 DEC 97;Build 113
; References to ^PS(52.7 supported by DBIA #2173
; Reference to ^ORRDI1 is supported by DBIA 4659
; Reference to ^XTMP("ORRDI" is supported by DBIA 4660
; Reference to ^GMRADPT supported by DBIA #10099
SELDEV() ;*** Ask for device type for report to output to ***
K IOP,%ZIS,POP,IO("Q")
S %ZIS("A")="Select output device: ",%ZIS("B")="",%ZIS="Q"
D ^%ZIS S PSJSTOP=$S(POP:1,1:0) I POP W !,"** No device selected or Report printed **" D EXIT
Q $G(PSJSTOP)
;
SETSORTQ(XDESC,XSAVE,ZTRTN) ;Queue to sort. D SETDEV^PSJMUTL(X,Y)
N I,X
K IO("Q"),ZTSAVE,ZTDTH,ZTSK
S ZTDESC=XDESC,PSGIO=ION,ZTIO=""
S PSGIODOC="" I $G(IO("DOC"))]"" S PSGIODOC=IO("DOC")
F I=1:1 S X=$P(XSAVE,";",I) Q:X="" S ZTSAVE(X)=""
D ^%ZTLOAD
Q
;
SETPRTQ(XDESC,XSAVE,ZTRTN) ;Queue to printer. D SETPRTQ^PSJMUTL(X,Y)
N I,X
S ZTIO=PSGIO,ZTDESC=XDESC,ZTDTH=$H,%ZIS="QN",IOP=PSGIO
I $G(PSGIODOC)]"" S ZTIO=ZTIO_";"_PSGIODOC
F I=1:1 S X=$P(XSAVE,";",I) Q:X="" S ZTSAVE(X)=""
D ^%ZIS,^%ZTLOAD
Q
;
EXITDEV ;
I $E(IOST)="C",('$G(PSJSTOP)) K DIR W ! S DIR(0)="EA",DIR("A")="Press Return to continue..." D ^DIR
S:$D(ZTQUEUED) ZTREQ="@"
S IOP="HOME" D ^%ZISC
Q
;
PRTCHK(PGCT) ;
I $E(IOST)="C",PGCT K DIR W ! S DIR(0)="E" D ^DIR S:'Y PSJSTOP=1
I $D(ZTQUEUED),$$S^%ZTLOAD S (ZSTOP,PSJSTOP)=1
I $G(PSJSTOP) W !!?20,"...Report stopped at user request..." K DIR S DIR(0)="EA",DIR("A")="Press Return to continue..." D ^DIR
Q $G(PSJSTOP)
;
EXIT ;
K %,%H,%I,%ZIS,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN
W:$E(IOST)="C"&($Y) @IOF
S:$D(ZTQUEUED) ZTREQ="@"
S IOP="HOME" D ^%ZISC
Q
ATS(REG,EXP,LN) ;
;*** Split allergies and adverse reactions from the allergy package.
;*** INPUT ***
;*** REG - the length the allergies and adv. reactions display on 1 pg.
;*** EXP - the length that will display on extra page.
;*** LN - for MAR, allergies and reations are display on 1 line.
; - for Profile, display allergies and reactions on separate ln.
;*** OUTPUT ***
;*** PSGALG - Allergies array.
;*** PSGADR - Adverse Reactions array.
;***** rlw - 1/16/96 added PSGVALG for verified allergies and PSGVADR for verified adverse reactions.
GETGMRA ;
N GMRA,GMRAL,GMRANKA,GMRAOTH,LEN,X,Y,TYPE,NAME,SORT,ALG,VALG,ADR,VADR,ALGCT,VALGCT,ADRCT,VADRCT,VERIFIED
K PSGADR,PSGALG,PSGVADR,PSGVALG
S (VALGCT,ALGCT,VADRCT,ADRCT,PSGVALG,PSGALG,PSGVADR,PSGADR)=0,(PSGVALG(1),PSGALG(1),PSGVADR(1),PSGADR(1))=""
S:'$G(DFN)&$G(PSGP) DFN=PSGP
S:'$G(PSGP)&$G(DFN) PSGP=DFN
S GMRA="0^0^111",DFN=PSGP D ^GMRADPT
I $G(PSJWHERE)="PSJLMUTL" S PSJGMRAL=GMRAL Q:(GMRAL="")!(GMRAL=0)
I GMRAL="" S:$E(IOST)="P" (PSGVALG,PSGALG,PSGVADR,PSGADR)=20,$P(PSGALG(1),"_",20)=" ",(PSGVALG(1),PSGADR(1),PSGVADR(1))=PSGALG(1) Q
I GMRAL=0 S (PSGVALG,PSGALG)=3,(PSGALG(1),PSGVALG(1))="NKA" S:$E(IOST)="P" PSGADR=20,$P(PSGADR(1),"_",20)=" ",PSGVADR=20,PSGVADR(1)=PSGADR(1) Q
;
SORT ;*** Set up the allergies and adv. reactions arrays.
F X=0:0 S X=$O(GMRAL(X)) Q:'X S TYPE=$P(GMRAL(X),U,5),NAME=$P(GMRAL(X),U,2),VERIFIED=$P(GMRAL(X),U,4) D
.S SORT=$P(GMRAL(X),U,7),SORT=$S(SORT="D":1,SORT="DF":2,SORT="DFO":3,SORT="DO":4,SORT="F":5,SORT="FO":6,1:7)
.S:(TYPE=0)&(VERIFIED=1) PSGVALG=PSGVALG+$L(NAME),VALGCT=VALGCT+1,VALG(SORT_NAME)=""
.S:(TYPE=0)&(VERIFIED=0) PSGALG=PSGALG+$L(NAME),ALGCT=ALGCT+1,ALG(SORT_NAME)=""
.S:(TYPE>0)&(VERIFIED=0) PSGADR=PSGADR+$L(NAME),ADRCT=ADRCT+1,ADR(SORT_NAME)=""
.S:(TYPE>0)&(VERIFIED=1) PSGVADR=PSGVADR+$L(NAME),VADRCT=VADRCT+1,VADR(SORT_NAME)=""
;
CALLEN ;*** Calculate the total length for allergy and adv.reaction arrays.
S:VALGCT>1 PSGVALG=PSGVALG+((VALGCT-1)*2) S:$E(IOST)="P"&'PSGVALG PSGVALG=20,$P(PSGVALG(1),"_",20)=" "
S:ALGCT>1 PSGALG=PSGALG+((ALGCT-1)*2) S:$E(IOST)="P"&'PSGALG PSGALG=20,$P(PSGALG(1),"_",20)=" "
S:VADRCT>1 PSGVADR=PSGVADR+((VADRCT-1)*2) S:$E(IOST)="P"&'PSGVADR PSGVADR=20,$P(PSGVADR(1),"_",20)=" "
S:ADRCT>1 PSGADR=PSGADR+((ADRCT-1)*2) S:$E(IOST)="P"&'PSGADR PSGADR=20,$P(PSGADR(1),"_",20)=" "
S (VALGCT,ALGCT,VADRCT,ADRCT)=1
S:LN=1 LEN=$S((PSGALG+PSGVALG+PSGADR+PSGVADR)>REG:EXP,1:REG)
S:LN>1 LEN=$S($S(PSGALG>REG:1,PSGADR>REG:1,PSGVALG>REG:1,PSGVADR>REG:1,1:0):EXP,1:REG)
;
SETARRAY ;*** Concatenate allergies and adv. reaction together into display len.
S (X,Y)="" F S X=$O(VALG(X)) Q:X="" S:LEN'>($L(Y)+$L(X)+1) PSGVALG(VALGCT)=Y_",",Y="",VALGCT=VALGCT+1 S:Y]"" Y=Y_", " S Y=Y_$E(X,2,$L(X))
S:$G(PSGVALG(VALGCT))="" PSGVALG(VALGCT)=Y
S (X,Y)="" F S X=$O(ALG(X)) Q:X="" S:LEN'>($L(Y)+$L(X)+1) PSGALG(ALGCT)=Y_",",Y="",ALGCT=ALGCT+1 S:Y]"" Y=Y_", " S Y=Y_$E(X,2,$L(X))
S:$G(PSGALG(ALGCT))="" PSGALG(ALGCT)=Y
S (X,Y)="" F S X=$O(ADR(X)) Q:X="" S:LEN'>($L(Y)+$L(X)+1) PSGADR(ADRCT)=Y_",",Y="",ADRCT=ADRCT+1 S:Y]"" Y=Y_", " S Y=Y_$E(X,2,$L(X))
S:$G(PSGADR(ADRCT))="" PSGADR(ADRCT)=Y
S (X,Y)="" F S X=$O(VADR(X)) Q:X="" S:LEN'>($L(Y)+$L(X)+1) PSGVADR(VADRCT)=Y_",",Y="",VADRCT=VADRCT+1 S:Y]"" Y=Y_", " S Y=Y_$E(X,2,$L(X))
S:$G(PSGVADR(VADRCT))="" PSGVADR(VADRCT)=Y
Q
;
NAMENEED(DRGX,LEN,NEED) ;*** Return the number of lines needed.
;*
;* DRG - AD/SOL LEN - Drug name length NEED - line needed
;*
S NEED=0
F X=0:0 S X=$O(DRG(DRGX,X)) Q:'X D NAME^PSIVUTL(DRG(DRGX,X),LEN,.NAME,1) S NEED=NEED+$S($G(NAME(2))]"":2,1:1) I DRGX="SOL",$P(^PS(52.7,+DRG(DRGX,X),0),U,4)]"" S NEED=NEED+1
Q
RAD ;
I $T(HAVEHDR^ORRDI1)']"" Q
I '$$HAVEHDR^ORRDI1 Q
S PSGRALG=1,PSGRALG(1)="No remote data available"
I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) G REMOTE2
I $T(GET^ORRDI1)]"" D GET^ORRDI1(DFN,"ART") D
. N S1,REAC,A,FILE,LEN K ^TMP($J,"PSJART")
. S S1=0,LEN=57,PSGRALG=1,PSGRALG(1)="" F S S1=$O(^XTMP("ORRDI","ART",DFN,S1)) Q:'S1 D
..S A=$G(^XTMP("ORRDI","ART",DFN,S1,"GMRALLERGY",0)),REAC=$P(A,"^",2) ;RTC 231778
..Q:REAC="" ;RTC 231778
..S FILE=$P($P(A,"^",3),"99VA",2)
..I FILE'=50.6,FILE'=120.82,FILE'=50.605,FILE'=50.416 Q
..S ^TMP($J,"PSJART",REAC)=""
. S REAC="" F S REAC=$O(^TMP($J,"PSJART",REAC)) Q:REAC="" D
.. I $L(PSGRALG(PSGRALG))+$L(REAC)<LEN S PSGRALG(PSGRALG)=PSGRALG(PSGRALG)_REAC_", " Q
.. S PSGRALG=PSGRALG+1,PSGRALG(PSGRALG)=" "_REAC_", ",LEN=77
. S A=$L(PSGRALG(PSGRALG)) I $E(PSGRALG(PSGRALG),A-1,A)=", " S PSGRALG(PSGRALG)=$E(PSGRALG(PSGRALG),1,A-2)
REMOTE2 ;
S ^TMP("PSJALL",$J,PSJLN,0)=" Remote: "_$G(PSGRALG(1)),PSJLN=PSJLN+1
F I=2:1:PSGRALG S ^TMP("PSJALL",$J,PSJLN,0)=PSGRALG(I),PSJLN=PSJLN+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJMUTL 6585 printed Nov 22, 2024@17:17:54 Page 2
PSJMUTL ;BIR/MV - UTLILITY USE FOR QUEUING... ;25 Nov 98 9:13 AM
+1 ;;5.0;INPATIENT MEDICATIONS;**8,21,31,160,281**;16 DEC 97;Build 113
+2 ; References to ^PS(52.7 supported by DBIA #2173
+3 ; Reference to ^ORRDI1 is supported by DBIA 4659
+4 ; Reference to ^XTMP("ORRDI" is supported by DBIA 4660
+5 ; Reference to ^GMRADPT supported by DBIA #10099
SELDEV() ;*** Ask for device type for report to output to ***
+1 KILL IOP,%ZIS,POP,IO("Q")
+2 SET %ZIS("A")="Select output device: "
SET %ZIS("B")=""
SET %ZIS="Q"
+3 DO ^%ZIS
SET PSJSTOP=$SELECT(POP:1,1:0)
IF POP
WRITE !,"** No device selected or Report printed **"
DO EXIT
+4 QUIT $GET(PSJSTOP)
+5 ;
SETSORTQ(XDESC,XSAVE,ZTRTN) ;Queue to sort. D SETDEV^PSJMUTL(X,Y)
+1 NEW I,X
+2 KILL IO("Q"),ZTSAVE,ZTDTH,ZTSK
+3 SET ZTDESC=XDESC
SET PSGIO=ION
SET ZTIO=""
+4 SET PSGIODOC=""
IF $GET(IO("DOC"))]""
SET PSGIODOC=IO("DOC")
+5 FOR I=1:1
SET X=$PIECE(XSAVE,";",I)
if X=""
QUIT
SET ZTSAVE(X)=""
+6 DO ^%ZTLOAD
+7 QUIT
+8 ;
SETPRTQ(XDESC,XSAVE,ZTRTN) ;Queue to printer. D SETPRTQ^PSJMUTL(X,Y)
+1 NEW I,X
+2 SET ZTIO=PSGIO
SET ZTDESC=XDESC
SET ZTDTH=$HOROLOG
SET %ZIS="QN"
SET IOP=PSGIO
+3 IF $GET(PSGIODOC)]""
SET ZTIO=ZTIO_";"_PSGIODOC
+4 FOR I=1:1
SET X=$PIECE(XSAVE,";",I)
if X=""
QUIT
SET ZTSAVE(X)=""
+5 DO ^%ZIS
DO ^%ZTLOAD
+6 QUIT
+7 ;
EXITDEV ;
+1 IF $EXTRACT(IOST)="C"
IF ('$GET(PSJSTOP))
KILL DIR
WRITE !
SET DIR(0)="EA"
SET DIR("A")="Press Return to continue..."
DO ^DIR
+2 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 SET IOP="HOME"
DO ^%ZISC
+4 QUIT
+5 ;
PRTCHK(PGCT) ;
+1 IF $EXTRACT(IOST)="C"
IF PGCT
KILL DIR
WRITE !
SET DIR(0)="E"
DO ^DIR
if 'Y
SET PSJSTOP=1
+2 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET (ZSTOP,PSJSTOP)=1
+3 IF $GET(PSJSTOP)
WRITE !!?20,"...Report stopped at user request..."
KILL DIR
SET DIR(0)="EA"
SET DIR("A")="Press Return to continue..."
DO ^DIR
+4 QUIT $GET(PSJSTOP)
+5 ;
EXIT ;
+1 KILL %,%H,%I,%ZIS,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN
+2 if $EXTRACT(IOST)="C"&($Y)
WRITE @IOF
+3 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 SET IOP="HOME"
DO ^%ZISC
+5 QUIT
ATS(REG,EXP,LN) ;
+1 ;*** Split allergies and adverse reactions from the allergy package.
+2 ;*** INPUT ***
+3 ;*** REG - the length the allergies and adv. reactions display on 1 pg.
+4 ;*** EXP - the length that will display on extra page.
+5 ;*** LN - for MAR, allergies and reations are display on 1 line.
+6 ; - for Profile, display allergies and reactions on separate ln.
+7 ;*** OUTPUT ***
+8 ;*** PSGALG - Allergies array.
+9 ;*** PSGADR - Adverse Reactions array.
+10 ;***** rlw - 1/16/96 added PSGVALG for verified allergies and PSGVADR for verified adverse reactions.
GETGMRA ;
+1 NEW GMRA,GMRAL,GMRANKA,GMRAOTH,LEN,X,Y,TYPE,NAME,SORT,ALG,VALG,ADR,VADR,ALGCT,VALGCT,ADRCT,VADRCT,VERIFIED
+2 KILL PSGADR,PSGALG,PSGVADR,PSGVALG
+3 SET (VALGCT,ALGCT,VADRCT,ADRCT,PSGVALG,PSGALG,PSGVADR,PSGADR)=0
SET (PSGVALG(1),PSGALG(1),PSGVADR(1),PSGADR(1))=""
+4 if '$GET(DFN)&$GET(PSGP)
SET DFN=PSGP
+5 if '$GET(PSGP)&$GET(DFN)
SET PSGP=DFN
+6 SET GMRA="0^0^111"
SET DFN=PSGP
DO ^GMRADPT
+7 IF $GET(PSJWHERE)="PSJLMUTL"
SET PSJGMRAL=GMRAL
if (GMRAL="")!(GMRAL=0)
QUIT
+8 IF GMRAL=""
if $EXTRACT(IOST)="P"
SET (PSGVALG,PSGALG,PSGVADR,PSGADR)=20
SET $PIECE(PSGALG(1),"_",20)=" "
SET (PSGVALG(1),PSGADR(1),PSGVADR(1))=PSGALG(1)
QUIT
+9 IF GMRAL=0
SET (PSGVALG,PSGALG)=3
SET (PSGALG(1),PSGVALG(1))="NKA"
if $EXTRACT(IOST)="P"
SET PSGADR=20
SET $PIECE(PSGADR(1),"_",20)=" "
SET PSGVADR=20
SET PSGVADR(1)=PSGADR(1)
QUIT
+10 ;
SORT ;*** Set up the allergies and adv. reactions arrays.
+1 FOR X=0:0
SET X=$ORDER(GMRAL(X))
if 'X
QUIT
SET TYPE=$PIECE(GMRAL(X),U,5)
SET NAME=$PIECE(GMRAL(X),U,2)
SET VERIFIED=$PIECE(GMRAL(X),U,4)
Begin DoDot:1
+2 SET SORT=$PIECE(GMRAL(X),U,7)
SET SORT=$SELECT(SORT="D":1,SORT="DF":2,SORT="DFO":3,SORT="DO":4,SORT="F":5,SORT="FO":6,1:7)
+3 if (TYPE=0)&(VERIFIED=1)
SET PSGVALG=PSGVALG+$LENGTH(NAME)
SET VALGCT=VALGCT+1
SET VALG(SORT_NAME)=""
+4 if (TYPE=0)&(VERIFIED=0)
SET PSGALG=PSGALG+$LENGTH(NAME)
SET ALGCT=ALGCT+1
SET ALG(SORT_NAME)=""
+5 if (TYPE>0)&(VERIFIED=0)
SET PSGADR=PSGADR+$LENGTH(NAME)
SET ADRCT=ADRCT+1
SET ADR(SORT_NAME)=""
+6 if (TYPE>0)&(VERIFIED=1)
SET PSGVADR=PSGVADR+$LENGTH(NAME)
SET VADRCT=VADRCT+1
SET VADR(SORT_NAME)=""
End DoDot:1
+7 ;
CALLEN ;*** Calculate the total length for allergy and adv.reaction arrays.
+1 if VALGCT>1
SET PSGVALG=PSGVALG+((VALGCT-1)*2)
if $EXTRACT(IOST)="P"&'PSGVALG
SET PSGVALG=20
SET $PIECE(PSGVALG(1),"_",20)=" "
+2 if ALGCT>1
SET PSGALG=PSGALG+((ALGCT-1)*2)
if $EXTRACT(IOST)="P"&'PSGALG
SET PSGALG=20
SET $PIECE(PSGALG(1),"_",20)=" "
+3 if VADRCT>1
SET PSGVADR=PSGVADR+((VADRCT-1)*2)
if $EXTRACT(IOST)="P"&'PSGVADR
SET PSGVADR=20
SET $PIECE(PSGVADR(1),"_",20)=" "
+4 if ADRCT>1
SET PSGADR=PSGADR+((ADRCT-1)*2)
if $EXTRACT(IOST)="P"&'PSGADR
SET PSGADR=20
SET $PIECE(PSGADR(1),"_",20)=" "
+5 SET (VALGCT,ALGCT,VADRCT,ADRCT)=1
+6 if LN=1
SET LEN=$SELECT((PSGALG+PSGVALG+PSGADR+PSGVADR)>REG:EXP,1:REG)
+7 if LN>1
SET LEN=$SELECT($SELECT(PSGALG>REG:1,PSGADR>REG:1,PSGVALG>REG:1,PSGVADR>REG:1,1:0):EXP,1:REG)
+8 ;
SETARRAY ;*** Concatenate allergies and adv. reaction together into display len.
+1 SET (X,Y)=""
FOR
SET X=$ORDER(VALG(X))
if X=""
QUIT
if LEN'>($LENGTH(Y)+$LENGTH(X)+1)
SET PSGVALG(VALGCT)=Y_","
SET Y=""
SET VALGCT=VALGCT+1
if Y]""
SET Y=Y_", "
SET Y=Y_$EXTRACT(X,2,$LENGTH(X))
+2 if $GET(PSGVALG(VALGCT))=""
SET PSGVALG(VALGCT)=Y
+3 SET (X,Y)=""
FOR
SET X=$ORDER(ALG(X))
if X=""
QUIT
if LEN'>($LENGTH(Y)+$LENGTH(X)+1)
SET PSGALG(ALGCT)=Y_","
SET Y=""
SET ALGCT=ALGCT+1
if Y]""
SET Y=Y_", "
SET Y=Y_$EXTRACT(X,2,$LENGTH(X))
+4 if $GET(PSGALG(ALGCT))=""
SET PSGALG(ALGCT)=Y
+5 SET (X,Y)=""
FOR
SET X=$ORDER(ADR(X))
if X=""
QUIT
if LEN'>($LENGTH(Y)+$LENGTH(X)+1)
SET PSGADR(ADRCT)=Y_","
SET Y=""
SET ADRCT=ADRCT+1
if Y]""
SET Y=Y_", "
SET Y=Y_$EXTRACT(X,2,$LENGTH(X))
+6 if $GET(PSGADR(ADRCT))=""
SET PSGADR(ADRCT)=Y
+7 SET (X,Y)=""
FOR
SET X=$ORDER(VADR(X))
if X=""
QUIT
if LEN'>($LENGTH(Y)+$LENGTH(X)+1)
SET PSGVADR(VADRCT)=Y_","
SET Y=""
SET VADRCT=VADRCT+1
if Y]""
SET Y=Y_", "
SET Y=Y_$EXTRACT(X,2,$LENGTH(X))
+8 if $GET(PSGVADR(VADRCT))=""
SET PSGVADR(VADRCT)=Y
+9 QUIT
+10 ;
NAMENEED(DRGX,LEN,NEED) ;*** Return the number of lines needed.
+1 ;*
+2 ;* DRG - AD/SOL LEN - Drug name length NEED - line needed
+3 ;*
+4 SET NEED=0
+5 FOR X=0:0
SET X=$ORDER(DRG(DRGX,X))
if 'X
QUIT
DO NAME^PSIVUTL(DRG(DRGX,X),LEN,.NAME,1)
SET NEED=NEED+$SELECT($GET(NAME(2))]"":2,1:1)
IF DRGX="SOL"
IF $PIECE(^PS(52.7,+DRG(DRGX,X),0),U,4)]""
SET NEED=NEED+1
+6 QUIT
RAD ;
+1 IF $TEXT(HAVEHDR^ORRDI1)']""
QUIT
+2 IF '$$HAVEHDR^ORRDI1
QUIT
+3 SET PSGRALG=1
SET PSGRALG(1)="No remote data available"
+4 IF $DATA(^XTMP("ORRDI","OUTAGE INFO","DOWN"))
GOTO REMOTE2
+5 IF $TEXT(GET^ORRDI1)]""
DO GET^ORRDI1(DFN,"ART")
Begin DoDot:1
+6 NEW S1,REAC,A,FILE,LEN
KILL ^TMP($JOB,"PSJART")
+7 SET S1=0
SET LEN=57
SET PSGRALG=1
SET PSGRALG(1)=""
FOR
SET S1=$ORDER(^XTMP("ORRDI","ART",DFN,S1))
if 'S1
QUIT
Begin DoDot:2
+8 ;RTC 231778
SET A=$GET(^XTMP("ORRDI","ART",DFN,S1,"GMRALLERGY",0))
SET REAC=$PIECE(A,"^",2)
+9 ;RTC 231778
if REAC=""
QUIT
+10 SET FILE=$PIECE($PIECE(A,"^",3),"99VA",2)
+11 IF FILE'=50.6
IF FILE'=120.82
IF FILE'=50.605
IF FILE'=50.416
QUIT
+12 SET ^TMP($JOB,"PSJART",REAC)=""
End DoDot:2
+13 SET REAC=""
FOR
SET REAC=$ORDER(^TMP($JOB,"PSJART",REAC))
if REAC=""
QUIT
Begin DoDot:2
+14 IF $LENGTH(PSGRALG(PSGRALG))+$LENGTH(REAC)<LEN
SET PSGRALG(PSGRALG)=PSGRALG(PSGRALG)_REAC_", "
QUIT
+15 SET PSGRALG=PSGRALG+1
SET PSGRALG(PSGRALG)=" "_REAC_", "
SET LEN=77
End DoDot:2
+16 SET A=$LENGTH(PSGRALG(PSGRALG))
IF $EXTRACT(PSGRALG(PSGRALG),A-1,A)=", "
SET PSGRALG(PSGRALG)=$EXTRACT(PSGRALG(PSGRALG),1,A-2)
End DoDot:1
REMOTE2 ;
+1 SET ^TMP("PSJALL",$JOB,PSJLN,0)=" Remote: "_$GET(PSGRALG(1))
SET PSJLN=PSJLN+1
+2 FOR I=2:1:PSGRALG
SET ^TMP("PSJALL",$JOB,PSJLN,0)=PSGRALG(I)
SET PSJLN=PSJLN+1
+3 QUIT
