source: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPHR0.m@ 1800

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

initial load of WorldVistAEHR

File size: 3.8 KB
RevLine 
[613]1GMRAPHR0 ;HIRMFO/WAA-THIS PROGRAM WILL DISPLAY ALL PHARM FOR A PATIENT ;3/5/97 14:44
2 ;;4.0;Adverse Reaction Tracking;**7**;Mar 29, 1996
3DISP ;DISPLAY ALL THE DRUGS FOR THIS PATIENT
4 K ^UTILITY("PSG",$J),^UTILITY("PSIV",$J)
5 S GMRAPHRV=+$$VERSION^XPDUTL("PSO"),GMRAPHRG=$S(GMRAPHRV<6:"^UTILITY(",1:"^TMP(")
6 K @(GMRAPHRG_"""PSOO"",$J)"),GMRARRAY
7 S GMRACT=1,GMRACH=1
8 S DFN=+GMRAPA(0)
9 D DT Q:GMRAOUT
10 S GMRALOOK=1,GMRADATA=0
11 S X="PSOHCSUM" X ^%ZOSF("TEST") S:'$T GMRADATA=GMRADATA+1 I $T S PSOBEGIN=+$P($P(GMRABGDT,U),".") D ^PSOHCSUM
12 S X="PSJEEU0" X ^%ZOSF("TEST") S:'$T GMRADATA=GMRADATA+100 I $T S PSJEDT=GMRABGDT D ENHS^PSJEEU0
13 S GMRACT=1
14 S GMRAY="" F GMRAX=0:0 S GMRAY=$O(@(GMRAPHRG_"""PSOO"",$J,GMRAY)")) Q:GMRAY="" D
15 .S GMRAZ=$G(@(GMRAPHRG_"""PSOO"",$J,GMRAY,0)"))
16 .I $P(GMRAZ,U)'>$P(GMRAENDT,U) D
17 ..S GMRADRG="OP"_U_$P($P(GMRAZ,U,3),";",2)_U_$G(@(GMRAPHRG_"""PSOO"",$J,GMRAY,1)"))_U_$P(GMRAZ,U,2)
18 ..S GMRARRAY("PH",GMRACT)=GMRADRG,GMRACT=GMRACT+1
19 ..Q
20 .Q
21 S GMRAY="" F GMRAX=0:0 S GMRAY=$O(^UTILITY("PSG",$J,GMRAY)) Q:GMRAY="" D
22 .S GMRAZ=$G(^UTILITY("PSG",$J,GMRAY))
23 .I $P(GMRAZ,U,2)'<GMRABGDT,$P(GMRAZ,U)'>GMRAENDT D
24 ..S GMRADRG="D"_U_$P($P(GMRAZ,U,3),";",2)_U_$P(GMRAZ,U,6)_U_$P($P(GMRAZ,U,7),";",2)_U_$P($P(GMRAZ,U,8),";",2)_U_$P(GMRAZ,U,1,2)
25 ..S GMRARRAY("PH",GMRACT)=GMRADRG,GMRACT=GMRACT+1
26 ..Q
27 .Q
28 S GMRAY="" F GMRAX=0:0 S GMRAY=$O(^UTILITY("PSIV",$J,GMRAY)) Q:GMRAY="" D
29 .S GMRAZ=$G(^UTILITY("PSIV",$J,GMRAY,0))
30 .I $P(GMRAZ,U,2)'<GMRABGDT,$P(GMRAZ,U)'>GMRAENDT D
31 ..S GMRADRG(1)=GMRAZ,GMRAZ=0 F S GMRAZ=$O(^UTILITY("PSIV",$J,GMRAY,"A",GMRAZ)) Q:GMRAZ<1 D
32 ...S GMRADRG="IV"_U_$P($P(^UTILITY("PSIV",$J,GMRAY,"A",GMRAZ),U),";",2)_U_$P(^(GMRAZ),U,2)
33 ...S GMRADRG=GMRADRG_U_$P(GMRADRG(1),U,5,6)_U_$P(GMRADRG(1),U,1,2)
34 ...S GMRARRAY("PH",GMRACT)=GMRADRG,GMRACT=GMRACT+1
35 ...Q
36 ..Q
37 .Q
38DISP2 W @IOF,!,"PHARMACY:",?60,"Start/Last",!
39 W ?3,"Drug",?61,"Fill DT",?71,"Stop Date"
40 I '$D(GMRARRAY("PH")) W !,?5,"THERE AREN'T ANY RXS ON FILE FOR THIS PATIENT" Q
41 F GMRACH=GMRACH:1 Q:'$D(GMRARRAY("PH",GMRACH)) D Q:GMRAOUT
42 .I $Y+3>IOSL D Q:GMRAOUT
43 ..F W !,"Press RETURN to continue, ""^"" to exit: " R X:DTIME S:'$T X="^^" S:"^^"[X GMRAOUT=$L(X) Q:("^^"[X) W !,?4,$C(7),"PRESS RETURN TO CONTINUE OR ""^"" TO EXIT THIS LISTING"
44 ..Q:GMRAOUT
45 ..W @IOF,!,"PHARMACY:",?60,"Start/Last",!,?3,"Drug",?61,"Fill DT",?71,"Stop Date"
46 ..Q
47 .S GMRADRG=GMRARRAY("PH",GMRACH)
48 .I $P(GMRADRG,U)="OP" D
49 ..W !,GMRACH,?3,"(O) ",$E($P(GMRADRG,U,2),1,50)
50 ..W ?61,$$FMTE^XLFDT($P(GMRADRG,U,4),2)
51 ..W !,?3,$P(GMRADRG,U,3)
52 ..Q
53 .I $P(GMRADRG,U)="D" D
54 ..W !,GMRACH,?3,$E($P(GMRADRG,U,2),1,54)
55 ..W ?61,$$FMTE^XLFDT($P(GMRADRG,U,6),2)
56 ..W ?71,$$FMTE^XLFDT($P(GMRADRG,U,7),2)
57 ..W !,?3,$P(GMRADRG,U,3)," ",$P(GMRADRG,U,4)," ",$P(GMRADRG,U,5)
58 ..Q
59 .I $P(GMRADRG,U)="IV" D
60 ..W !,GMRACH,?3,$E($P(GMRADRG,U,2),1,54)
61 ..W ?61,$$FMTE^XLFDT($P(GMRADRG,U,6),2)
62 ..W ?71,$$FMTE^XLFDT($P(GMRADRG,U,7),2)
63 ..W !,?3,$P(GMRADRG,U,3)," IV ",$P(GMRADRG,U,4)," ",$P(GMRADRG,U,5)
64 ..Q
65 .Q
66 K ^UTILITY("PSG",$J),^UTILITY("PSIV",$J),@(GMRAPHRG_"""PSOO"",$J)")
67 Q
68DT ;SELECT LOOKUP DATE RANGE
69 I GMRALOOK Q
70 I '$D(GMRABGDT) S (GMRABGDT,GMRAENDT)=""
71 W !
72 S X1=$S(GMRABGDT'="":+GMRABGDT,1:GMRADT),X2=0 D C^%DTC S Y=(X*10000\1/10000) D D^DIQ
73 S %DT("A")="View DRUG from: ",%DT("B")=Y,%DT="AETP" D ^%DT K %DT S:X="^" GMRAOUT=2 Q:+Y<1 S GMRABGDT=+Y D D^DIQ S $P(GMRABGDT,U,2)=Y
74 S X1=$S(GMRAENDT'="":+GMRAENDT,1:GMRADT),X2=0 D C^%DTC S Y=(X*10000\1/10000) D D^DIQ S %DT("A")="To: ",%DT("B")=Y,%DT="AETP",%DT(0)=+GMRABGDT D ^%DT K %DT S:X="^" GMRAOUT=2 Q:Y<1
75 S GMRAENDT=+Y S:'$P(GMRAENDT,".",2) GMRAENDT=GMRAENDT+.24 D D^DIQ S $P(GMRAENDT,U,2)=Y
76 Q
77DTFOR ;SET THE FORMAT OF DATE TIME TO MM/DD/YY@TIME
78 Q:Y<1
79 S GMRATEMP=$$DATE^GMRAUTL1(Y)
80 S GMRATEMP=$E(GMRATEMP,4,5)_"/"_$E(GMRATEMP,6,7)_"/"_$E(GMRATEMP,2,3)
81 I $P(Y,"@",2)'="" S GMRATEMP=GMRATEMP_"@"_$P(Y,"@",2)
82 S Y=GMRATEMP K GMRATEMP
83 Q
Note: See TracBrowser for help on using the repository browser.