source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOARCF2.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 3.4 KB
Line 
1PSOARCF2 ;BHAM ISC/LGH,LC - RX RETRIEVE ; 07/07/92
2 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
3 U PSOAT S PSORWND=$$REWIND^%ZIS(PSOAIO,PSOAIOT,PSOAPAR) I $G(PSORWND)=0 U IO(0) W !!,"HFS file failed to rewind" G END
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 K ^TMP($J,"ZRX"),NM,SS,X,XX,XNM,XSS,T,TZ,A,DG,GD,I,Y,RX,D
11 Q
12PR ;PATIENT READ
13 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)
14 I D>"" F I=1:1:D D READT S T(2,I)=X
15 I A>"" F I=1:1:A D READT S T(3,I)=X
16 I DG>"" F I=1:1:DG D READT S T(4,I)=X
17 I GD>"" F I=1:1:GD D READT S T(5,I)=X
18 D:'PSOAPF DPR,HD1^PSOARCF4 S PSOAPF=1 ;DISPLAY DEMO INFO
19RXR D READT G:(X="!")!(X="") END G:$P(X,"^",2)'=NM PAR G:X="" END
20RXR2 I $P($G(X),"^",2)'=NM D READT G:($G(X)="!")!($G(X)="") END
21 G:(X="!")!(X="")!($P(X,"^",2)'=NM) END S RX(0)=X D READT
22 I (X["$$"),$P(X,"$$",1)["1," D NODE1
23 I (X["$$"),$P(X,"$$",1)["4," D NODE4
24 I (X["$$"),$P(X,"$$",1)["5," D NODE5
25 S RX(2)=X D READT S RX(3)=X D READT
26 I (X["$$"),$P(X,"$$",1)["A," D NODEA
27 I (X["$$"),$P(X,"$$",1)["L," D NODEL
28 I (X["$$"),$P(X,"$$",1)["P," D NODEP
29 I (X["$$"),$P(X,"$$",1)["IB" S RX("IB")=$P(X,"$$",2) D READT
30 I (X["$$"),$P(X,"$$",1)["C," S RX("C")=$P(X,"$$",2) D READT
31 I (X["$$"),$P(X,"$$",1)["D," S RX("D")=$P(X,"$$",2) D READT
32 I (X["$$"),$P(X,"$$",1)["S," S RX("S")=$P(X,"$$",2) D READT
33RXR1 U PSOAP D ^PSOARCR2 D PAGE U PSOAT G RXR2
34DPR 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)
35 W !,$P(T(1),"^",7),!,$P(T(1),"^",8)," ",$P(T(1),"^",9)
36 I +$P(T(1),"^",10) W !,"CANNOT USE SAFETY CAPS." I +$P(T(1),"^",11) W ?40,"DIALYSIS PATIENT"
37 I $P(T(2),"^")'="" W !,$P(T(2),"^")
38 W !,"DISABILITIES: " G MA:D'>0
39 F I=1:1:D W:($Y+$L(T(2,I))+1)>PSOACPM !?15 W T(2,I),","
40MA W !!,"REACTIONS: ",$S(((A'>0)&(DG'>0)&(GD'>0)):"UNKNOWN",1:"")
41 I A>0 F I=1:1:A W:($Y+$L(T(3,I))+1)>PSOACPM !?15 W T(3,I),","
42 I DG>0 F I=1:1:DG W:($Y+$L(T(4,I))+1)>PSOACPM !?15 W T(4,I),","
43 I GD>0 F I=1:1:GD W:($Y+$L(T(5,I))+1)>PSOACPM !?15 W T(5,I),","
44 K T Q
45PAGE Q:$Y'>(PSOACPL-22)
46 D HD1^PSOARCF4 Q
47PSOAT ;CHECK FOR EOF
48 U PSOAT S:$$STATUS^%ZISH PSORWND=$$REWIND^%ZIS(PSOAIO,PSOAIOT,PSOAPAR) I $G(PSORWND)=0 U IO(0) W !!,"HFS file failed to rewind" G END
49 U PSOAT
50 Q
51NODE1 S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
52 F D READT Q:($P(X,"^")'["$")!($P(X,"$$",1)'["1,") S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
53 Q
54NODE4 S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
55 F D READT Q:($P(X,"^")'["$")!($P(X,"$$",1)'["4,") S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
56 Q
57NODE5 S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
58 F D READT Q:($P(X,"^")'["$")!($P(X,"$$",1)'["5,") S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
59 Q
60NODEA S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
61 F D READT Q:($P(X,"^")'["$$")!($P(X,"$$",1)'["A,") S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
62 Q
63NODEL S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
64 F D READT Q:($P(X,"^")'["$")!($P(X,"$$",1)'["L,") S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
65 Q
66NODEP S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
67 F D READT Q:($P(X,"^")'["$$")!($P(X,"$$",1)'["P,") S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
68 Q
69READT D PSOAT R X:DTIME G:'$T END G END:X="" Q
Note: See TracBrowser for help on using the repository browser.