Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRAPHR0

GMRAPHR0.m

Go to the documentation of this file.
  1. GMRAPHR0 ;HIRMFO/WAA-THIS PROGRAM WILL DISPLAY ALL PHARM FOR A PATIENT ;4/12/17 14:44
  1. ;;4.0;Adverse Reaction Tracking;**7,54**;Mar 29, 1996;Build 5
  1. DISP ;DISPLAY ALL THE DRUGS FOR THIS PATIENT
  1. K ^UTILITY("PSG",$J),^UTILITY("PSIV",$J)
  1. S GMRAPHRV=+$$VERSION^XPDUTL("PSO"),GMRAPHRG=$S(GMRAPHRV<6:"^UTILITY(",1:"^TMP(")
  1. K @(GMRAPHRG_"""PSOO"",$J)"),GMRARRAY
  1. S GMRACT=1,GMRACH=1
  1. S DFN=+GMRAPA(0)
  1. N GMRAFNVA S GMRAFNVA=0 ;54
  1. D DT Q:GMRAOUT
  1. S GMRALOOK=1,GMRADATA=0
  1. S X="PSOHCSUM" X ^%ZOSF("TEST") S:'$T GMRADATA=GMRADATA+1 I $T S PSOBEGIN=+$P($P(GMRABGDT,U),".") D ^PSOHCSUM
  1. S X="PSJEEU0" X ^%ZOSF("TEST") S:'$T GMRADATA=GMRADATA+100 I $T S PSJEDT=GMRABGDT D ENHS^PSJEEU0
  1. S GMRACT=1
  1. S GMRAY="" F GMRAX=0:0 S GMRAY=$O(@(GMRAPHRG_"""PSOO"",$J,GMRAY)")) Q:GMRAY="" D
  1. .I GMRAY="NVA" S GMRAFNVA=1 Q ;54
  1. .S GMRAZ=$G(@(GMRAPHRG_"""PSOO"",$J,GMRAY,0)"))
  1. .I $P(GMRAZ,U)'>$P(GMRAENDT,U) D
  1. ..S GMRADRG="OP"_U_$P($P(GMRAZ,U,3),";",2)_U_$G(@(GMRAPHRG_"""PSOO"",$J,GMRAY,1)"))_U_$P(GMRAZ,U,2)
  1. ..S GMRARRAY("PH",GMRACT)=GMRADRG,GMRACT=GMRACT+1
  1. ..Q
  1. .Q
  1. S GMRAY="" F GMRAX=0:0 S GMRAY=$O(^UTILITY("PSG",$J,GMRAY)) Q:GMRAY="" D
  1. .S GMRAZ=$G(^UTILITY("PSG",$J,GMRAY))
  1. .I $P(GMRAZ,U,2)'<GMRABGDT,$P(GMRAZ,U)'>GMRAENDT D
  1. ..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)
  1. ..S GMRARRAY("PH",GMRACT)=GMRADRG,GMRACT=GMRACT+1
  1. ..Q
  1. .Q
  1. S GMRAY="" F GMRAX=0:0 S GMRAY=$O(^UTILITY("PSIV",$J,GMRAY)) Q:GMRAY="" D
  1. .S GMRAZ=$G(^UTILITY("PSIV",$J,GMRAY,0))
  1. .I $P(GMRAZ,U,2)'<GMRABGDT,$P(GMRAZ,U)'>GMRAENDT D
  1. ..S GMRADRG(1)=GMRAZ,GMRAZ=0 F S GMRAZ=$O(^UTILITY("PSIV",$J,GMRAY,"A",GMRAZ)) Q:GMRAZ<1 D
  1. ...S GMRADRG="IV"_U_$P($P(^UTILITY("PSIV",$J,GMRAY,"A",GMRAZ),U),";",2)_U_$P(^(GMRAZ),U,2)
  1. ...S GMRADRG=GMRADRG_U_$P(GMRADRG(1),U,5,6)_U_$P(GMRADRG(1),U,1,2)
  1. ...S GMRARRAY("PH",GMRACT)=GMRADRG,GMRACT=GMRACT+1
  1. ...Q
  1. ..Q
  1. .Q
  1. DISP2 W @IOF,!,"PHARMACY:",?60,"Start/Last",!
  1. W ?3,"Drug",?61,"Fill DT",?71,"Stop Date"
  1. I '$D(GMRARRAY("PH")) W !,?5,"THERE AREN'T ANY RXS ON FILE FOR THIS PATIENT" Q
  1. F GMRACH=GMRACH:1 Q:'$D(GMRARRAY("PH",GMRACH)) D Q:GMRAOUT
  1. .I $Y+3>IOSL D Q:GMRAOUT
  1. ..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"
  1. ..Q:GMRAOUT
  1. ..W @IOF,!,"PHARMACY:",?60,"Start/Last",!,?3,"Drug",?61,"Fill DT",?71,"Stop Date"
  1. ..Q
  1. .S GMRADRG=GMRARRAY("PH",GMRACH)
  1. .I $P(GMRADRG,U)="OP" D
  1. ..W !,GMRACH,?3,"(O) ",$E($P(GMRADRG,U,2),1,50)
  1. ..W ?61,$$FMTE^XLFDT($P(GMRADRG,U,4),2)
  1. ..W !,?3,$P(GMRADRG,U,3)
  1. ..Q
  1. .I $P(GMRADRG,U)="D" D
  1. ..W !,GMRACH,?3,$E($P(GMRADRG,U,2),1,54)
  1. ..W ?61,$$FMTE^XLFDT($P(GMRADRG,U,6),2)
  1. ..W ?71,$$FMTE^XLFDT($P(GMRADRG,U,7),2)
  1. ..W !,?3,$P(GMRADRG,U,3)," ",$P(GMRADRG,U,4)," ",$P(GMRADRG,U,5)
  1. ..Q
  1. .I $P(GMRADRG,U)="IV" D
  1. ..W !,GMRACH,?3,$E($P(GMRADRG,U,2),1,54)
  1. ..W ?61,$$FMTE^XLFDT($P(GMRADRG,U,6),2)
  1. ..W ?71,$$FMTE^XLFDT($P(GMRADRG,U,7),2)
  1. ..W !,?3,$P(GMRADRG,U,3)," IV ",$P(GMRADRG,U,4)," ",$P(GMRADRG,U,5)
  1. ..Q
  1. .Q
  1. I GMRAFNVA D ;54
  1. .W !,"There are Non-VA Meds on this patient's profile. Please review for possible" ;54
  1. .W !,"manual inclusion in this report.",! ;54
  1. .Q ;54
  1. K ^UTILITY("PSG",$J),^UTILITY("PSIV",$J),@(GMRAPHRG_"""PSOO"",$J)")
  1. Q
  1. DT ;SELECT LOOKUP DATE RANGE
  1. I GMRALOOK Q
  1. I '$D(GMRABGDT) S (GMRABGDT,GMRAENDT)=""
  1. W !
  1. S X1=$S(GMRABGDT'="":+GMRABGDT,1:GMRADT),X2=0 D C^%DTC S Y=(X*10000\1/10000) D D^DIQ
  1. 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
  1. 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
  1. S GMRAENDT=+Y S:'$P(GMRAENDT,".",2) GMRAENDT=GMRAENDT+.24 D D^DIQ S $P(GMRAENDT,U,2)=Y
  1. Q
  1. DTFOR ;SET THE FORMAT OF DATE TIME TO MM/DD/YY@TIME
  1. Q:Y<1
  1. S GMRATEMP=$$DATE^GMRAUTL1(Y)
  1. S GMRATEMP=$E(GMRATEMP,4,5)_"/"_$E(GMRATEMP,6,7)_"/"_$E(GMRATEMP,2,3)
  1. I $P(Y,"@",2)'="" S GMRATEMP=GMRATEMP_"@"_$P(Y,"@",2)
  1. S Y=GMRATEMP K GMRATEMP
  1. Q