| [613] | 1 | PSJMUTL ;BIR/MV-UTLILITY USE FOR QUEUING... ;25 Nov 98 / 9:13 AM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**8,21,31,160**;16 DEC 97;Build 12
|
|---|
| 3 | ; References to ^PS(52.7 supported by DBIA #2173
|
|---|
| 4 | ; Reference to ^ORRDI1 is supported by DBIA 4659
|
|---|
| 5 | ; Reference to ^XTMP("ORRDI" is supported by DBIA 4660
|
|---|
| 6 | ; Reference to ^GMRADPT supported by DBIA #10099
|
|---|
| 7 | SELDEV() ;*** Ask for device type for report to output to ***
|
|---|
| 8 | K IOP,%ZIS,POP,IO("Q")
|
|---|
| 9 | S %ZIS("A")="Select output device: ",%ZIS("B")="",%ZIS="Q"
|
|---|
| 10 | D ^%ZIS S PSJSTOP=$S(POP:1,1:0) I POP W !,"** No device selected or Report printed **" D EXIT
|
|---|
| 11 | Q $G(PSJSTOP)
|
|---|
| 12 | ;
|
|---|
| 13 | SETSORTQ(XDESC,XSAVE,ZTRTN) ;Queue to sort. D SETDEV^PSJMUTL(X,Y)
|
|---|
| 14 | N I,X
|
|---|
| 15 | K IO("Q"),ZTSAVE,ZTDTH,ZTSK
|
|---|
| 16 | S ZTDESC=XDESC,PSGIO=ION,ZTIO=""
|
|---|
| 17 | S PSGIODOC="" I $G(IO("DOC"))]"" S PSGIODOC=IO("DOC")
|
|---|
| 18 | F I=1:1 S X=$P(XSAVE,";",I) Q:X="" S ZTSAVE(X)=""
|
|---|
| 19 | D ^%ZTLOAD
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | SETPRTQ(XDESC,XSAVE,ZTRTN) ;Queue to printer. D SETPRTQ^PSJMUTL(X,Y)
|
|---|
| 23 | N I,X
|
|---|
| 24 | S ZTIO=PSGIO,ZTDESC=XDESC,ZTDTH=$H,%ZIS="QN",IOP=PSGIO
|
|---|
| 25 | I $G(PSGIODOC)]"" S ZTIO=ZTIO_";"_PSGIODOC
|
|---|
| 26 | F I=1:1 S X=$P(XSAVE,";",I) Q:X="" S ZTSAVE(X)=""
|
|---|
| 27 | D ^%ZIS,^%ZTLOAD
|
|---|
| 28 | Q
|
|---|
| 29 | ;
|
|---|
| 30 | EXITDEV ;
|
|---|
| 31 | I $E(IOST)="C",('$G(PSJSTOP)) K DIR W ! S DIR(0)="EA",DIR("A")="Press Return to continue..." D ^DIR
|
|---|
| 32 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 33 | S IOP="HOME" D ^%ZISC
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | PRTCHK(PGCT) ;
|
|---|
| 37 | I $E(IOST)="C",PGCT K DIR W ! S DIR(0)="E" D ^DIR S:'Y PSJSTOP=1
|
|---|
| 38 | I $D(ZTQUEUED),$$S^%ZTLOAD S (ZSTOP,PSJSTOP)=1
|
|---|
| 39 | I $G(PSJSTOP) W !!?20,"...Report stopped at user request..." K DIR S DIR(0)="EA",DIR("A")="Press Return to continue..." D ^DIR
|
|---|
| 40 | Q $G(PSJSTOP)
|
|---|
| 41 | ;
|
|---|
| 42 | EXIT ;
|
|---|
| 43 | K %,%H,%I,%ZIS,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN
|
|---|
| 44 | W:$E(IOST)="C"&($Y) @IOF
|
|---|
| 45 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 46 | S IOP="HOME" D ^%ZISC
|
|---|
| 47 | Q
|
|---|
| 48 | ATS(REG,EXP,LN) ;
|
|---|
| 49 | ;*** Split allergies and adverse reactions from the allergy package.
|
|---|
| 50 | ;*** INPUT ***
|
|---|
| 51 | ;*** REG - the length the allergies and adv. reactions display on 1 pg.
|
|---|
| 52 | ;*** EXP - the length that will display on extra page.
|
|---|
| 53 | ;*** LN - for MAR, allergies and reations are display on 1 line.
|
|---|
| 54 | ; - for Profile, display allergies and reactions on separate ln.
|
|---|
| 55 | ;*** OUTPUT ***
|
|---|
| 56 | ;*** PSGALG - Allergies array.
|
|---|
| 57 | ;*** PSGADR - Adverse Reactions array.
|
|---|
| 58 | ;***** rlw - 1/16/96 added PSGVALG for verified allergies and PSGVADR for verified adverse reactions.
|
|---|
| 59 | GETGMRA ;
|
|---|
| 60 | N GMRA,GMRAL,GMRANKA,GMRAOTH,LEN,X,Y,TYPE,NAME,SORT,ALG,VALG,ADR,VADR,ALGCT,VALGCT,ADRCT,VADRCT,VERIFIED
|
|---|
| 61 | K PSGADR,PSGALG,PSGVADR,PSGVALG
|
|---|
| 62 | S (VALGCT,ALGCT,VADRCT,ADRCT,PSGVALG,PSGALG,PSGVADR,PSGADR)=0,(PSGVALG(1),PSGALG(1),PSGVADR(1),PSGADR(1))=""
|
|---|
| 63 | S:'$G(DFN)&$G(PSGP) DFN=PSGP
|
|---|
| 64 | S:'$G(PSGP)&$G(DFN) PSGP=DFN
|
|---|
| 65 | S GMRA="0^0^111",DFN=PSGP D ^GMRADPT
|
|---|
| 66 | I $G(PSJWHERE)="PSJLMUTL" S PSJGMRAL=GMRAL Q:(GMRAL="")!(GMRAL=0)
|
|---|
| 67 | I GMRAL="" S:$E(IOST)="P" (PSGVALG,PSGALG,PSGVADR,PSGADR)=20,$P(PSGALG(1),"_",20)=" ",(PSGVALG(1),PSGADR(1),PSGVADR(1))=PSGALG(1) Q
|
|---|
| 68 | 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
|
|---|
| 69 | ;
|
|---|
| 70 | SORT ;*** Set up the allergies and adv. reactions arrays.
|
|---|
| 71 | 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
|
|---|
| 72 | .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)
|
|---|
| 73 | .S:(TYPE=0)&(VERIFIED=1) PSGVALG=PSGVALG+$L(NAME),VALGCT=VALGCT+1,VALG(SORT_NAME)=""
|
|---|
| 74 | .S:(TYPE=0)&(VERIFIED=0) PSGALG=PSGALG+$L(NAME),ALGCT=ALGCT+1,ALG(SORT_NAME)=""
|
|---|
| 75 | .S:(TYPE>0)&(VERIFIED=0) PSGADR=PSGADR+$L(NAME),ADRCT=ADRCT+1,ADR(SORT_NAME)=""
|
|---|
| 76 | .S:(TYPE>0)&(VERIFIED=1) PSGVADR=PSGVADR+$L(NAME),VADRCT=VADRCT+1,VADR(SORT_NAME)=""
|
|---|
| 77 | ;
|
|---|
| 78 | CALLEN ;*** Calculate the total length for allergy and adv.reaction arrays.
|
|---|
| 79 | S:VALGCT>1 PSGVALG=PSGVALG+((VALGCT-1)*2) S:$E(IOST)="P"&'PSGVALG PSGVALG=20,$P(PSGVALG(1),"_",20)=" "
|
|---|
| 80 | S:ALGCT>1 PSGALG=PSGALG+((ALGCT-1)*2) S:$E(IOST)="P"&'PSGALG PSGALG=20,$P(PSGALG(1),"_",20)=" "
|
|---|
| 81 | S:VADRCT>1 PSGVADR=PSGVADR+((VADRCT-1)*2) S:$E(IOST)="P"&'PSGVADR PSGVADR=20,$P(PSGVADR(1),"_",20)=" "
|
|---|
| 82 | S:ADRCT>1 PSGADR=PSGADR+((ADRCT-1)*2) S:$E(IOST)="P"&'PSGADR PSGADR=20,$P(PSGADR(1),"_",20)=" "
|
|---|
| 83 | S (VALGCT,ALGCT,VADRCT,ADRCT)=1
|
|---|
| 84 | S:LN=1 LEN=$S((PSGALG+PSGVALG+PSGADR+PSGVADR)>REG:EXP,1:REG)
|
|---|
| 85 | S:LN>1 LEN=$S($S(PSGALG>REG:1,PSGADR>REG:1,PSGVALG>REG:1,PSGVADR>REG:1,1:0):EXP,1:REG)
|
|---|
| 86 | ;
|
|---|
| 87 | SETARRAY ;*** Concatenate allergies and adv. reaction together into display len.
|
|---|
| 88 | 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))
|
|---|
| 89 | S:$G(PSGVALG(VALGCT))="" PSGVALG(VALGCT)=Y
|
|---|
| 90 | 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))
|
|---|
| 91 | S:$G(PSGALG(ALGCT))="" PSGALG(ALGCT)=Y
|
|---|
| 92 | 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))
|
|---|
| 93 | S:$G(PSGADR(ADRCT))="" PSGADR(ADRCT)=Y
|
|---|
| 94 | 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))
|
|---|
| 95 | S:$G(PSGVADR(VADRCT))="" PSGVADR(VADRCT)=Y
|
|---|
| 96 | Q
|
|---|
| 97 | ;
|
|---|
| 98 | NAMENEED(DRGX,LEN,NEED) ;*** Return the number of lines needed.
|
|---|
| 99 | ;*
|
|---|
| 100 | ;* DRG - AD/SOL LEN - Drug name length NEED - line needed
|
|---|
| 101 | ;*
|
|---|
| 102 | S NEED=0
|
|---|
| 103 | 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
|
|---|
| 104 | Q
|
|---|
| 105 | RAD ;
|
|---|
| 106 | I $T(HAVEHDR^ORRDI1)']"" Q
|
|---|
| 107 | I '$$HAVEHDR^ORRDI1 Q
|
|---|
| 108 | S PSGRALG=1,PSGRALG(1)="No remote data available"
|
|---|
| 109 | I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) G REMOTE2
|
|---|
| 110 | I $T(GET^ORRDI1)]"" D GET^ORRDI1(DFN,"ART") D
|
|---|
| 111 | . N S1,REAC,A,FILE,LEN K ^TMP($J,"PSJART")
|
|---|
| 112 | . S S1=0,LEN=57,PSGRALG=1,PSGRALG(1)="" F S S1=$O(^XTMP("ORRDI","ART",DFN,S1)) Q:'S1 D
|
|---|
| 113 | .. S A=$G(^XTMP("ORRDI","ART",DFN,S1,"REACTANT",0)),REAC=$P(A,"^",2),FILE=$P($P(A,"^",3),"99VA",2)
|
|---|
| 114 | .. I FILE'=50.6,FILE'=120.82,FILE'=50.605,FILE'=50.416 Q
|
|---|
| 115 | .. S ^TMP($J,"PSJART",REAC)=""
|
|---|
| 116 | . S REAC="" F S REAC=$O(^TMP($J,"PSJART",REAC)) Q:REAC="" D
|
|---|
| 117 | .. I $L(PSGRALG(PSGRALG))+$L(REAC)<LEN S PSGRALG(PSGRALG)=PSGRALG(PSGRALG)_REAC_", " Q
|
|---|
| 118 | .. S PSGRALG=PSGRALG+1,PSGRALG(PSGRALG)=" "_REAC_", ",LEN=77
|
|---|
| 119 | . S A=$L(PSGRALG(PSGRALG)) I $E(PSGRALG(PSGRALG),A-1,A)=", " S PSGRALG(PSGRALG)=$E(PSGRALG(PSGRALG),1,A-2)
|
|---|
| 120 | REMOTE2 ;
|
|---|
| 121 | S ^TMP("PSJALL",$J,PSJLN,0)=" Remote: "_$G(PSGRALG(1)),PSJLN=PSJLN+1
|
|---|
| 122 | F I=2:1:PSGRALG S ^TMP("PSJALL",$J,PSJLN,0)=PSGRALG(I),PSJLN=PSJLN+1
|
|---|
| 123 | Q
|
|---|
