source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOP1.m@ 677

Last change on this file since 677 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.9 KB
Line 
1PSOP1 ;BHAM ISC/SAB - prints short medication profile ;02/25/94
2 ;;7.0;OUTPATIENT PHARMACY;**15,46,103,132,148,233**;DEC 1997;Build 8
3 ;External reference to ^PSDRUG supported by DBIA 221
4 ;External reference to ^PS(50.605 supported by DBIA 696
5 K RX,DTOUT,DIRUT,DIROUT,DUOUT
6 D HD S DRUG="" F I=0:0 S DRUG=$O(^TMP($J,DRUG)) Q:DRUG=""!($G(PQT)) D G:$D(DTOUT)!($D(DUOUT))!($D(DIROUT)) Q
7 .F J=0:0 S J=$O(^TMP($J,DRUG,J)) Q:'J!($G(PQT)) S RX0=^(J),RX2=$G(^PSRX(J,2)),$P(RX0,"^",15)=$G(^("STA")),CP=$S(+$G(^PSRX(J,"IB")):"$",1:" ") S:$P(RX2,"^",15)&($P(RX2,"^",2)) RST($P(RX2,"^",2))=1 S:$P(RX0,"^",15)="" $P(RX0,"^",15)=-1 D W
8 D:'$G(PQT) PEND^PSOP2,NVA^PSOP2
9Q D ^%ZISC K ^TMP($J),PQT,PSODTCT,ST,D0,DIC,DIR,DIRUT,DUOUT,G,II,K,RXD,RXF,ZX,DRUG,X,DFN,PHYS,PSRT,CT,AL,I1,PLS,REF,LMI,PI,FN,Y,I,J,RX,DRX,ST,RX0,RX2,DA,PPPSTAT,PPP,EEEE,PPPCNT,PENDREX,PSOPEND,PPDIS,PPOI,PCOUNT,PP,FSIG S:$D(ZTQUEUED) ZTREQ="@"
10 K ZZZZ Q
11W I $Y+6>IOSL,$E(IOST)="C" D DIR W @IOF Q:$D(PQT) D HD
12 N PSOBADR
13 U IO I IO'=IO(0),$Y+6>IOSL W @IOF D HD
14 I $E(IOST)'="C",$Y+6>IOSL W @IOF D HD
15 D STAT^PSOFUNC S STA="A^N^R^H^P^S^^^^^^E^DC^^DC^DE^PH",ST=$P(STA,"^",(ST0+1)) K STA
16 S PSOBADR=$O(^PSRX(J,"L",9999),-1)
17 I PSOBADR'="" S PSOBADR=$G(^PSRX(J,"L",PSOBADR,0)) I PSOBADR["(BAD ADDRESS)" S PSOBADR="B"
18 I PSOBADR'="B" S PSOBADR=""
19 S ST=ST_PSOBADR
20 W !,CP_$P(RX0,"^"),$$ECME^PSOBPSUT(J),?13,$S($D(^PSDRUG(+$P(RX0,"^",6),0)):$P(^(0),"^"),1:"NOT ON FILE"),?54,$S($L(ST)=1:" "_ST,1:ST)
21 S RXD=$P($G(^PSRX(J,3)),"^"),RXF=$P(RX0,"^",9) F II=0:0 S II=$O(^PSRX(J,1,II)) Q:'II S RXF=RXF-1 S:$P(^PSRX(J,1,II,0),"^",16) RST($P(^(0),"^"))=1
22 W ?58,$S($L(RXF)=1:" "_RXF,1:RXF)
23 W ?61,$E($P(RX0,"^",13),4,5)_"-"_$E($P(RX0,"^",13),6,7)_"-"_$E($P(RX0,"^",13),2,3) W:RXD ?70,$E(RXD,4,5)_"-"_$E(RXD,6,7)_"-"_$E(RXD,2,3)_$S($G(RST(RXD)):"R",1:"")
24 S PSOPRSIG=$P($G(^PSRX(J,"SIG")),"^",2) K FSIG,BSIG D
25 .I PSOPRSIG D FSIG^PSOUTLA("R",J,50) Q
26 .D EN2^PSOUTLA1(J,50) F GGGG=0:0 S GGGG=$O(BSIG(GGGG)) Q:'GGGG S FSIG(GGGG)=BSIG(GGGG)
27 K PSOPRSIG,GGGG,BSIG
28 W !?5,"QTY: ",$P(RX0,"^",7),?24,"SIG: ",$G(FSIG(1)) D:$O(FSIG(1))
29 .F GGGG=1:0 S GGGG=$O(FSIG(GGGG)) Q:'GGGG!($G(PQT)) W !,?29,$G(FSIG(GGGG)) D:$Y+5>IOSL&($E(IOST)="C") DIR Q:$G(PQT) I '$G(PQT),($Y+5>IOSL) W @IOF D HD
30 K GGGG,FSIG Q:$G(PQT)
31 ;D SIG
32 K RST Q
33HD D:PAGE>1
34 .W !,"Patient: "_$P(^DPT(DFN,0),"^")_" ("_$E($P(^DPT(DFN,0),"^",9),6,9)_")",?70,"Page: "_PAGE
35 .W !?(80-$L("Medication Profile Sorted by "_HDR))/2,"Medication Profile Sorted by "_HDR W:$G(FR)]"" !?(80-$L(FR_" to "_TO))/2,FR_" to "_TO
36 W !?57,"REF",!?1,"Rx#",?13,"Drug",?54,"ST",?57,"REM",?62,"Issued",?70,"Last Fill",!,PSOPLINE S PAGE=PAGE+1
37 Q
38SORT K DIR,DUOUT,DTOUT
39 S DIR("B")="All",DIR("A",1)=" ",DIR("A")="All Medications or Selection (A/S): ",DIR(0)="SAM^A:All;S:Select Range",DIR("?",1)="Enter 'A' to Print Entire Medication Profile",DIR("?")=" or 'S' for Selection Range" D ^DIR
40 K DIR Q:$D(DIRUT)!(Y="A")!(Y="E") D @PSRT
41 Q
42DATE ;asks date range
43 W ! K %DT S %DT="AEX",%DT("A")="Starting Date: " D ^%DT I "^"[X S DUOUT=1 Q
44 G:Y<0 DATE S SDT=+Y,%DT(0)=SDT,FR=$E(SDT,4,5)_"/"_$E(SDT,6,7)_"/"_$E(SDT,2,3)
45EDT S %DT("A")="Ending Date: " D ^%DT I "^"[X S DUOUT=1 Q
46 G:Y<0 EDT S EDT=+Y,DTS=1,TO=$E(EDT,4,5)_"/"_$E(EDT,6,7)_"/"_$E(EDT,2,3)
47 K %DT Q
48DRUG ;asks drug list
49 W ! S DIC("A")="Start with Drug: ",DIC(0)="AEMQ",DIC=50
50 S DIC("S")="I $S('$D(^PSDRUG(Y,""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0),$S('$D(^PSDRUG(Y,2)):1,$P(^(2),""^"",3)'[""O"":0,1:1)"
51 D ^DIC I "^"[X S DUOUT=1 K DIC Q
52 G:Y<0 DRUG S FR=$P(Y,"^",2)
53 F %=$L($E(FR,1,30)):-1:1 S M=$A(FR,%) I M>32 S Y1=$E(FR,1,%-1)_$C(M-1)_$C(122) Q
54 S PSFR=Y1 K Y1,Y,X
55TO S DIC("A")="To Drug: " D ^DIC I "^"[X S DUOUT=1 K DIC Q
56 G:Y<0 TO I FR]$P(Y,"^",2) W !,$C(7),"Less Than 'Start' Value" K X,Y G TO
57 S TO=$P(Y,"^",2),DRS=1
58 F %=$L($E(TO,1,30)):-1:1 S M=$A(TO,%) I M>32 S Y1=$E(TO,1,%-1)_$C(M+1)_$C(122) Q
59 S PSTO=Y1 K Y1,Y,X,DIC
60 Q
61CLSS ;asks drug class list
62 W ! S DIC("A")="Start with Drug Class: ",DIC(0)="AEQ",DIC=50.605 D ^DIC I "^"[X S DUOUT=1 Q
63 G:Y<0 CLSS S FR=$P(Y,"^",2)
64 F %=$L($E(FR,1,30)):-1:1 S M=$A(FR,%) I M>32 S Y1=$E(FR,1,%-1)_$C(M-1)_$C(122) Q
65 S PSFR=Y1 K Y1,Y,X
66TO1 S DIC("A")="To Drug Class: " D ^DIC I "^"[X S DUOUT=1 Q
67 G:Y<0 TO1 I FR]$P(Y,"^",2) W !,$C(7),"Less Than 'Start' Value" K X,Y G TO1
68 S TO=$P(Y,"^",2)
69 F %=$L($E(TO,1,30)):-1:1 S M=$A(TO,%) I M>32 S Y1=$E(TO,1,%-1)_$C(M+1)_$C(122) Q
70 S PSTO=Y1,CLS=1 K Y,Y1,X
71 Q
72DIR K PQT,DTOUT,DUOUT,DIR,DIRUT S DIR(0)="E" D ^DIR S:$D(DUOUT)!($D(DTOUT)) PQT=1 Q
73SIG I '$P(^PSRX(J,"SIG"),"^",2) D Q
74 .S X=$P(^PSRX(J,"SIG"),"^") D SIGONE^PSOHELP S SIG=$E($G(INS1),2,250)
75 .F SG=1:1:$L(SIG) W:($X+$L($P(SIG," ",SG)_" "))>$S(IOST["C-":IOM,1:70) !?6 W:$P(SIG," ",SG)]"" $P(SIG," ",SG)_" "
76 S MIG=$P(^PSRX(J,"SIG"),"^"),SIGOK=1 D
77 .F SG=1:1:$L(MIG) Q:$P(MIG," ",SG)="" W:($X+$L($P(MIG," ",SG)_" "))>$S(IOST["C-":IOM,1:70) !?6 W $P(MIG," ",SG)_" "
78 F I=0:0 S I=$O(^PSRX(RXN,"SIG1",I)) Q:'I S MIG=$P(^PSRX(RXN,"SIG1",I,0),"^") D
79 .F SG=1:1:$L(MIG) Q:$P(MIG," ",SG)="" W:($X+$L($P(MIG," ",SG)_" "))>$S(IOST["C-":IOM,1:70) !?6 W $P(MIG," ",SG)_" "
80 Q
Note: See TracBrowser for help on using the repository browser.