source: FOIAVistA/tag/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOARCR1.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 3.5 KB
Line 
1PSOARCR1 ;BHAM ISC/LGH - Rx retrieve ; 07/07/92
2 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
3 U PSOAT W @%MT("REW")
4 S PSOAPF=0
5R D PSOAT R X:DTIME G END:X="" G:X'="!" R
6PAR D PSOAT R X:DTIME G:'$T END G:$P(X,"^")=NM&($G(SS)=$P(X,"^",2)) PR G PAR
7END I $D(PSOAT) U IO(0) S IOP=PSOAT D ^%ZIS D ^%ZISC K IOP
8Q I $D(PSOAP) U IO(0) S IOP=PSOAP D ^%ZIS D ^%ZISC K IOP
9 K PSOACPM,PSOACPL,PSOACPF,NM,T,PSOAP,PSOAT,^TMP($J,"ZRX"),A,DG,GD,I,PSOACDS,PSOAEOT,Y,RX,%MT,D,PSOAPF,PSOATNM,X,XX
10 Q
11PR ;patient read
12 S T(1)=X D READT S T(2)=X,D=$P(T(2),"^",2),A=$P(T(2),"^",3),DG=$P(T(2),"^",4),GD=$P(T(2),"^",5)
13 I D>"" F I=1:1:D D READT S T(2,I)=X
14 I A>"" F I=1:1:A D READT S T(3,I)=X
15 I DG>"" F I=1:1:DG D READT S T(4,I)=X
16 I GD>"" F I=1:1:GD D READT S T(5,I)=X
17 D:'PSOAPF DPR,HD1^PSOARCSV S PSOAPF=1 ;display demo info
18RXR D READT G:(X="!")!(X="") END G:$P(X,"^",2)'=NM PAR G:X="" END
19RXR2 I $P($G(X),"^",2)'=NM D READT G:($G(X)="!")!($G(X)="") END
20 G:(X="!")!(X="")!($P(X,"^",2)'=NM) END S RX(0)=X D READT
21 I (X["$$"),$P(X,"$$",1)["1," D NODE1
22 I (X["$$"),$P(X,"$$",1)["4," D NODE4
23 I (X["$$"),$P(X,"$$",1)["5," D NODE5
24 S RX(2)=X D READT S RX(3)=X D READT
25 I (X["$$"),$P(X,"$$",1)["A," D NODEA
26 I (X["$$"),$P(X,"$$",1)["L," D NODEL
27 I (X["$$"),$P(X,"$$",1)["P," D NODEP
28 I (X["$$"),$P(X,"$$",1)["IB" S RX("IB")=$P(X,"$$",2) D READT
29 I (X["$$"),$P(X,"$$",1)["C," S RX("C")=$P(X,"$$",2) D READT
30 I (X["$$"),$P(X,"$$",1)["D," S RX("D")=$P(X,"$$",2) D READT
31 I (X["$$"),$P(X,"$$",1)["S," S RX("S")=$P(X,"$$",2) D READT
32RXR1 U PSOAP D ^PSOARCR2 D PAGE U PSOAT G RXR2
33DPR U PSOAP W !!,NM,?55,"ID#: ",$P(T(1),"^",2),?75,"ELIG: ",$P(T(1),"^",3),!,$P(T(1),"^",4),?55,"DOB: ",$P(T(1),"^",5),?75,"PHONE: ",$P(T(1),"^",6)
34 W !,$P(T(1),"^",7),!,$P(T(1),"^",8)," ",$P(T(1),"^",9)
35 I +$P(T(1),"^",10) W !,"CANNOT USE SAFETY CAPS." I +$P(T(1),"^",11) W ?40,"DIALYSIS PATIENT"
36 I $P(T(2),"^")'="" W !,$P(T(2),"^")
37 W !,"DISABILITIES: " G MA:D'>0
38 F I=1:1:D W:($Y+$L(T(2,I))+1)>PSOACPM !?15 W T(2,I),","
39MA W !!,"REACTIONS: ",$S(((A'>0)&(DG'>0)&(GD'>0)):"UNKNOWN",1:"")
40 I A>0 F I=1:1:A W:($Y+$L(T(3,I))+1)>PSOACPM !?15 W T(3,I),","
41 I DG>0 F I=1:1:DG W:($Y+$L(T(4,I))+1)>PSOACPM !?15 W T(4,I),","
42 I GD>0 F I=1:1:GD W:($Y+$L(T(5,I))+1)>PSOACPM !?15 W T(5,I),","
43 K T Q
44PAGE Q:$Y'>(PSOACPL-22)
45 D HD1^PSOARCSV Q
46PSOAT ;check for eot, return psoaeot=1 if found
47 U PSOAT S PSOAEOT=0 X ^%ZOSF("EOT") I Y D EOT S PSOAEOT=1
48 U PSOAT Q
49EOT U IO(0) W !!?5,"** End of tape detected **",!?5,"After current tape rewinds, mount next tape" U PSOAT W @%MT("REW")
50READ U IO(0) W !?5,"Type <CR> to continue" R XX:DTIME I '$T W $C(7) G READ
51 W !!,"continuing" S PSOATNM=PSOATNM+1
52 Q
53NODE1 S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
54 F D READT Q:($P(X,"^")'["$")!($P(X,"$$",1)'["1,") S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
55 Q
56NODE4 S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
57 F D READT Q:($P(X,"^")'["$")!($P(X,"$$",1)'["4,") S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
58 Q
59NODE5 S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
60 F D READT Q:($P(X,"^")'["$")!($P(X,"$$",1)'["5,") S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
61 Q
62NODEA S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
63 F D READT Q:($P(X,"^")'["$$")!($P(X,"$$",1)'["A,") S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
64 Q
65NODEL S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
66 F D READT Q:($P(X,"^")'["$")!($P(X,"$$",1)'["L,") S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
67 Q
68NODEP S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
69 F D READT Q:($P(X,"^")'["$$")!($P(X,"$$",1)'["P,") S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
70 Q
71READT D PSOAT R X:DTIME G:'$T END G END:X="" Q
Note: See TracBrowser for help on using the repository browser.