GMRAPHR0 ;HIRMFO/WAA-THIS PROGRAM WILL DISPLAY ALL PHARM FOR A PATIENT ;3/5/97 14:44
;;4.0;Adverse Reaction Tracking;**7**;Mar 29, 1996
DISP ;DISPLAY ALL THE DRUGS FOR THIS PATIENT
K ^UTILITY("PSG",$J),^UTILITY("PSIV",$J)
S GMRAPHRV=+$$VERSION^XPDUTL("PSO"),GMRAPHRG=$S(GMRAPHRV<6:"^UTILITY(",1:"^TMP(")
K @(GMRAPHRG_"""PSOO"",$J)"),GMRARRAY
S GMRACT=1,GMRACH=1
S DFN=+GMRAPA(0)
D DT Q:GMRAOUT
S GMRALOOK=1,GMRADATA=0
S X="PSOHCSUM" X ^%ZOSF("TEST") S:'$T GMRADATA=GMRADATA+1 I $T S PSOBEGIN=+$P($P(GMRABGDT,U),".") D ^PSOHCSUM
S X="PSJEEU0" X ^%ZOSF("TEST") S:'$T GMRADATA=GMRADATA+100 I $T S PSJEDT=GMRABGDT D ENHS^PSJEEU0
S GMRACT=1
S GMRAY="" F GMRAX=0:0 S GMRAY=$O(@(GMRAPHRG_"""PSOO"",$J,GMRAY)")) Q:GMRAY="" D
.S GMRAZ=$G(@(GMRAPHRG_"""PSOO"",$J,GMRAY,0)"))
.I $P(GMRAZ,U)'>$P(GMRAENDT,U) D
..S GMRADRG="OP"_U_$P($P(GMRAZ,U,3),";",2)_U_$G(@(GMRAPHRG_"""PSOO"",$J,GMRAY,1)"))_U_$P(GMRAZ,U,2)
..S GMRARRAY("PH",GMRACT)=GMRADRG,GMRACT=GMRACT+1
..Q
.Q
S GMRAY="" F GMRAX=0:0 S GMRAY=$O(^UTILITY("PSG",$J,GMRAY)) Q:GMRAY="" D
.S GMRAZ=$G(^UTILITY("PSG",$J,GMRAY))
.I $P(GMRAZ,U,2)'<GMRABGDT,$P(GMRAZ,U)'>GMRAENDT D
..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)
..S GMRARRAY("PH",GMRACT)=GMRADRG,GMRACT=GMRACT+1
..Q
.Q
S GMRAY="" F GMRAX=0:0 S GMRAY=$O(^UTILITY("PSIV",$J,GMRAY)) Q:GMRAY="" D
.S GMRAZ=$G(^UTILITY("PSIV",$J,GMRAY,0))
.I $P(GMRAZ,U,2)'<GMRABGDT,$P(GMRAZ,U)'>GMRAENDT D
..S GMRADRG(1)=GMRAZ,GMRAZ=0 F S GMRAZ=$O(^UTILITY("PSIV",$J,GMRAY,"A",GMRAZ)) Q:GMRAZ<1 D
...S GMRADRG="IV"_U_$P($P(^UTILITY("PSIV",$J,GMRAY,"A",GMRAZ),U),";",2)_U_$P(^(GMRAZ),U,2)
...S GMRADRG=GMRADRG_U_$P(GMRADRG(1),U,5,6)_U_$P(GMRADRG(1),U,1,2)
...S GMRARRAY("PH",GMRACT)=GMRADRG,GMRACT=GMRACT+1
...Q
..Q
.Q
DISP2 W @IOF,!,"PHARMACY:",?60,"Start/Last",!
W ?3,"Drug",?61,"Fill DT",?71,"Stop Date"
I '$D(GMRARRAY("PH")) W !,?5,"THERE AREN'T ANY RXS ON FILE FOR THIS PATIENT" Q
F GMRACH=GMRACH:1 Q:'$D(GMRARRAY("PH",GMRACH)) D Q:GMRAOUT
.I $Y+3>IOSL D Q:GMRAOUT
..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"
..Q:GMRAOUT
..W @IOF,!,"PHARMACY:",?60,"Start/Last",!,?3,"Drug",?61,"Fill DT",?71,"Stop Date"
..Q
.S GMRADRG=GMRARRAY("PH",GMRACH)
.I $P(GMRADRG,U)="OP" D
..W !,GMRACH,?3,"(O) ",$E($P(GMRADRG,U,2),1,50)
..W ?61,$$FMTE^XLFDT($P(GMRADRG,U,4),2)
..W !,?3,$P(GMRADRG,U,3)
..Q
.I $P(GMRADRG,U)="D" D
..W !,GMRACH,?3,$E($P(GMRADRG,U,2),1,54)
..W ?61,$$FMTE^XLFDT($P(GMRADRG,U,6),2)
..W ?71,$$FMTE^XLFDT($P(GMRADRG,U,7),2)
..W !,?3,$P(GMRADRG,U,3)," ",$P(GMRADRG,U,4)," ",$P(GMRADRG,U,5)
..Q
.I $P(GMRADRG,U)="IV" D
..W !,GMRACH,?3,$E($P(GMRADRG,U,2),1,54)
..W ?61,$$FMTE^XLFDT($P(GMRADRG,U,6),2)
..W ?71,$$FMTE^XLFDT($P(GMRADRG,U,7),2)
..W !,?3,$P(GMRADRG,U,3)," IV ",$P(GMRADRG,U,4)," ",$P(GMRADRG,U,5)
..Q
.Q
K ^UTILITY("PSG",$J),^UTILITY("PSIV",$J),@(GMRAPHRG_"""PSOO"",$J)")
Q
DT ;SELECT LOOKUP DATE RANGE
I GMRALOOK Q
I '$D(GMRABGDT) S (GMRABGDT,GMRAENDT)=""
W !
S X1=$S(GMRABGDT'="":+GMRABGDT,1:GMRADT),X2=0 D C^%DTC S Y=(X*10000\1/10000) D D^DIQ
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
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
S GMRAENDT=+Y S:'$P(GMRAENDT,".",2) GMRAENDT=GMRAENDT+.24 D D^DIQ S $P(GMRAENDT,U,2)=Y
Q
DTFOR ;SET THE FORMAT OF DATE TIME TO MM/DD/YY@TIME
Q:Y<1
S GMRATEMP=$$DATE^GMRAUTL1(Y)
S GMRATEMP=$E(GMRATEMP,4,5)_"/"_$E(GMRATEMP,6,7)_"/"_$E(GMRATEMP,2,3)
I $P(Y,"@",2)'="" S GMRATEMP=GMRATEMP_"@"_$P(Y,"@",2)
S Y=GMRATEMP K GMRATEMP
Q
GMRAPHR0 ;HIRMFO/WAA-THIS PROGRAM WILL DISPLAY ALL PHARM FOR A PATIENT ;3/5/97 14:44
+1 ;;4.0;Adverse Reaction Tracking;**7**;Mar 29, 1996
DISP ;DISPLAY ALL THE DRUGS FOR THIS PATIENT
+1 KILL ^UTILITY("PSG",$JOB),^UTILITY("PSIV",$JOB)
+2 SET GMRAPHRV=+$$VERSION^XPDUTL("PSO")
SET GMRAPHRG=$SELECT(GMRAPHRV<6:"^UTILITY(",1:"^TMP(")
+3 KILL @(GMRAPHRG_"""PSOO"",$J)"),GMRARRAY
+4 SET GMRACT=1
SET GMRACH=1
+5 SET DFN=+GMRAPA(0)
+6 DO DT
IF GMRAOUT
QUIT
+7 SET GMRALOOK=1
SET GMRADATA=0
+8 SET X="PSOHCSUM"
XECUTE ^%ZOSF("TEST")
IF '$TEST
SET GMRADATA=GMRADATA+1
IF $TEST
SET PSOBEGIN=+$PIECE($PIECE(GMRABGDT,U),".")
DO ^PSOHCSUM
+9 SET X="PSJEEU0"
XECUTE ^%ZOSF("TEST")
IF '$TEST
SET GMRADATA=GMRADATA+100
IF $TEST
SET PSJEDT=GMRABGDT
DO ENHS^PSJEEU0
+10 SET GMRACT=1
+11 SET GMRAY=""
FOR GMRAX=0:0
SET GMRAY=$ORDER(@(GMRAPHRG_"""PSOO"",$J,GMRAY)"))
IF GMRAY=""
QUIT
Begin DoDot:1
+12 SET GMRAZ=$GET(@(GMRAPHRG_"""PSOO"",$J,GMRAY,0)"))
+13 IF $PIECE(GMRAZ,U)'>$PIECE(GMRAENDT,U)
Begin DoDot:2
+14 SET GMRADRG="OP"_U_$PIECE($PIECE(GMRAZ,U,3),";",2)_U_$GET(@(GMRAPHRG_"""PSOO"",$J,GMRAY,1)"))_U_$PIECE(GMRAZ,U,2)
+15 SET GMRARRAY("PH",GMRACT)=GMRADRG
SET GMRACT=GMRACT+1
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 SET GMRAY=""
FOR GMRAX=0:0
SET GMRAY=$ORDER(^UTILITY("PSG",$JOB,GMRAY))
IF GMRAY=""
QUIT
Begin DoDot:1
+19 SET GMRAZ=$GET(^UTILITY("PSG",$JOB,GMRAY))
+20 IF $PIECE(GMRAZ,U,2)'<GMRABGDT
IF $PIECE(GMRAZ,U)'>GMRAENDT
Begin DoDot:2
+21 SET GMRADRG="D"_U_$PIECE($PIECE(GMRAZ,U,3),";",2)_U_$PIECE(GMRAZ,U,6)_U_$PIECE($PIECE(GMRAZ,U,7),";",2)_U_$PIECE($PIECE(GMRAZ,U,8),";",2)_U_$PIECE(GMRAZ,U,1,2)
+22 SET GMRARRAY("PH",GMRACT)=GMRADRG
SET GMRACT=GMRACT+1
+23 QUIT
End DoDot:2
+24 QUIT
End DoDot:1
+25 SET GMRAY=""
FOR GMRAX=0:0
SET GMRAY=$ORDER(^UTILITY("PSIV",$JOB,GMRAY))
IF GMRAY=""
QUIT
Begin DoDot:1
+26 SET GMRAZ=$GET(^UTILITY("PSIV",$JOB,GMRAY,0))
+27 IF $PIECE(GMRAZ,U,2)'<GMRABGDT
IF $PIECE(GMRAZ,U)'>GMRAENDT
Begin DoDot:2
+28 SET GMRADRG(1)=GMRAZ
SET GMRAZ=0
FOR
SET GMRAZ=$ORDER(^UTILITY("PSIV",$JOB,GMRAY,"A",GMRAZ))
IF GMRAZ<1
QUIT
Begin DoDot:3
+29 SET GMRADRG="IV"_U_$PIECE($PIECE(^UTILITY("PSIV",$JOB,GMRAY,"A",GMRAZ),U),";",2)_U_$PIECE(^(GMRAZ),U,2)
+30 SET GMRADRG=GMRADRG_U_$PIECE(GMRADRG(1),U,5,6)_U_$PIECE(GMRADRG(1),U,1,2)
+31 SET GMRARRAY("PH",GMRACT)=GMRADRG
SET GMRACT=GMRACT+1
+32 QUIT
End DoDot:3
+33 QUIT
End DoDot:2
+34 QUIT
End DoDot:1
DISP2 WRITE @IOF,!,"PHARMACY:",?60,"Start/Last",!
+1 WRITE ?3,"Drug",?61,"Fill DT",?71,"Stop Date"
+2 IF '$DATA(GMRARRAY("PH"))
WRITE !,?5,"THERE AREN'T ANY RXS ON FILE FOR THIS PATIENT"
QUIT
+3 FOR GMRACH=GMRACH:1
IF '$DATA(GMRARRAY("PH",GMRACH))
QUIT
Begin DoDot:1
+4 IF $Y+3>IOSL
Begin DoDot:2
+5 FOR
WRITE !,"Press RETURN to continue, ""^"" to exit: "
READ X:DTIME
IF '$TEST
SET X="^^"
IF "^^"[X
SET GMRAOUT=$LENGTH(X)
IF ("^^"[X)
QUIT
WRITE !,?4,$CHAR(7),"PRESS RETURN TO CONTINUE OR ""^"" TO EXIT THIS LISTING"
+6 IF GMRAOUT
QUIT
+7 WRITE @IOF,!,"PHARMACY:",?60,"Start/Last",!,?3,"Drug",?61,"Fill DT",?71,"Stop Date"
+8 QUIT
End DoDot:2
IF GMRAOUT
QUIT
+9 SET GMRADRG=GMRARRAY("PH",GMRACH)
+10 IF $PIECE(GMRADRG,U)="OP"
Begin DoDot:2
+11 WRITE !,GMRACH,?3,"(O) ",$EXTRACT($PIECE(GMRADRG,U,2),1,50)
+12 WRITE ?61,$$FMTE^XLFDT($PIECE(GMRADRG,U,4),2)
+13 WRITE !,?3,$PIECE(GMRADRG,U,3)
+14 QUIT
End DoDot:2
+15 IF $PIECE(GMRADRG,U)="D"
Begin DoDot:2
+16 WRITE !,GMRACH,?3,$EXTRACT($PIECE(GMRADRG,U,2),1,54)
+17 WRITE ?61,$$FMTE^XLFDT($PIECE(GMRADRG,U,6),2)
+18 WRITE ?71,$$FMTE^XLFDT($PIECE(GMRADRG,U,7),2)
+19 WRITE !,?3,$PIECE(GMRADRG,U,3)," ",$PIECE(GMRADRG,U,4)," ",$PIECE(GMRADRG,U,5)
+20 QUIT
End DoDot:2
+21 IF $PIECE(GMRADRG,U)="IV"
Begin DoDot:2
+22 WRITE !,GMRACH,?3,$EXTRACT($PIECE(GMRADRG,U,2),1,54)
+23 WRITE ?61,$$FMTE^XLFDT($PIECE(GMRADRG,U,6),2)
+24 WRITE ?71,$$FMTE^XLFDT($PIECE(GMRADRG,U,7),2)
+25 WRITE !,?3,$PIECE(GMRADRG,U,3)," IV ",$PIECE(GMRADRG,U,4)," ",$PIECE(GMRADRG,U,5)
+26 QUIT
End DoDot:2
+27 QUIT
End DoDot:1
IF GMRAOUT
QUIT
+28 KILL ^UTILITY("PSG",$JOB),^UTILITY("PSIV",$JOB),@(GMRAPHRG_"""PSOO"",$J)")
+29 QUIT
DT ;SELECT LOOKUP DATE RANGE
+1 IF GMRALOOK
QUIT
+2 IF '$DATA(GMRABGDT)
SET (GMRABGDT,GMRAENDT)=""
+3 WRITE !
+4 SET X1=$SELECT(GMRABGDT'="":+GMRABGDT,1:GMRADT)
SET X2=0
DO C^%DTC
SET Y=(X*10000\1/10000)
DO D^DIQ
+5 SET %DT("A")="View DRUG from: "
SET %DT("B")=Y
SET %DT="AETP"
DO ^%DT
KILL %DT
IF X="^"
SET GMRAOUT=2
IF +Y<1
QUIT
SET GMRABGDT=+Y
DO D^DIQ
SET $PIECE(GMRABGDT,U,2)=Y
+6 SET X1=$SELECT(GMRAENDT'="":+GMRAENDT,1:GMRADT)
SET X2=0
DO C^%DTC
SET Y=(X*10000\1/10000)
DO D^DIQ
SET %DT("A")="To: "
SET %DT("B")=Y
SET %DT="AETP"
SET %DT(0)=+GMRABGDT
DO ^%DT
KILL %DT
IF X="^"
SET GMRAOUT=2
IF Y<1
QUIT
+7 SET GMRAENDT=+Y
IF '$PIECE(GMRAENDT,".",2)
SET GMRAENDT=GMRAENDT+.24
DO D^DIQ
SET $PIECE(GMRAENDT,U,2)=Y
+8 QUIT
DTFOR ;SET THE FORMAT OF DATE TIME TO MM/DD/YY@TIME
+1 IF Y<1
QUIT
+2 SET GMRATEMP=$$DATE^GMRAUTL1(Y)
+3 SET GMRATEMP=$EXTRACT(GMRATEMP,4,5)_"/"_$EXTRACT(GMRATEMP,6,7)_"/"_$EXTRACT(GMRATEMP,2,3)
+4 IF $PIECE(Y,"@",2)'=""
SET GMRATEMP=GMRATEMP_"@"_$PIECE(Y,"@",2)
+5 SET Y=GMRATEMP
KILL GMRATEMP
+6 QUIT
