- GMRAPHR0 ;HIRMFO/WAA-THIS PROGRAM WILL DISPLAY ALL PHARM FOR A PATIENT ;4/12/17 14:44
- ;;4.0;Adverse Reaction Tracking;**7,54**;Mar 29, 1996;Build 5
- 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)
- N GMRAFNVA S GMRAFNVA=0 ;54
- 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
- .I GMRAY="NVA" S GMRAFNVA=1 Q ;54
- .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
- I GMRAFNVA D ;54
- .W !,"There are Non-VA Meds on this patient's profile. Please review for possible" ;54
- .W !,"manual inclusion in this report.",! ;54
- .Q ;54
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAPHR0 4216 printed Feb 18, 2025@23:06:33 Page 2
- 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
- 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 ;54
- NEW GMRAFNVA
- SET GMRAFNVA=0
- +7 DO DT
- if GMRAOUT
- QUIT
- +8 SET GMRALOOK=1
- SET GMRADATA=0
- +9 SET X="PSOHCSUM"
- XECUTE ^%ZOSF("TEST")
- if '$TEST
- SET GMRADATA=GMRADATA+1
- IF $TEST
- SET PSOBEGIN=+$PIECE($PIECE(GMRABGDT,U),".")
- DO ^PSOHCSUM
- +10 SET X="PSJEEU0"
- XECUTE ^%ZOSF("TEST")
- if '$TEST
- SET GMRADATA=GMRADATA+100
- IF $TEST
- SET PSJEDT=GMRABGDT
- DO ENHS^PSJEEU0
- +11 SET GMRACT=1
- +12 SET GMRAY=""
- FOR GMRAX=0:0
- SET GMRAY=$ORDER(@(GMRAPHRG_"""PSOO"",$J,GMRAY)"))
- if GMRAY=""
- QUIT
- Begin DoDot:1
- +13 ;54
- IF GMRAY="NVA"
- SET GMRAFNVA=1
- QUIT
- +14 SET GMRAZ=$GET(@(GMRAPHRG_"""PSOO"",$J,GMRAY,0)"))
- +15 IF $PIECE(GMRAZ,U)'>$PIECE(GMRAENDT,U)
- Begin DoDot:2
- +16 SET GMRADRG="OP"_U_$PIECE($PIECE(GMRAZ,U,3),";",2)_U_$GET(@(GMRAPHRG_"""PSOO"",$J,GMRAY,1)"))_U_$PIECE(GMRAZ,U,2)
- +17 SET GMRARRAY("PH",GMRACT)=GMRADRG
- SET GMRACT=GMRACT+1
- +18 QUIT
- End DoDot:2
- +19 QUIT
- End DoDot:1
- +20 SET GMRAY=""
- FOR GMRAX=0:0
- SET GMRAY=$ORDER(^UTILITY("PSG",$JOB,GMRAY))
- if GMRAY=""
- QUIT
- Begin DoDot:1
- +21 SET GMRAZ=$GET(^UTILITY("PSG",$JOB,GMRAY))
- +22 IF $PIECE(GMRAZ,U,2)'<GMRABGDT
- IF $PIECE(GMRAZ,U)'>GMRAENDT
- Begin DoDot:2
- +23 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)
- +24 SET GMRARRAY("PH",GMRACT)=GMRADRG
- SET GMRACT=GMRACT+1
- +25 QUIT
- End DoDot:2
- +26 QUIT
- End DoDot:1
- +27 SET GMRAY=""
- FOR GMRAX=0:0
- SET GMRAY=$ORDER(^UTILITY("PSIV",$JOB,GMRAY))
- if GMRAY=""
- QUIT
- Begin DoDot:1
- +28 SET GMRAZ=$GET(^UTILITY("PSIV",$JOB,GMRAY,0))
- +29 IF $PIECE(GMRAZ,U,2)'<GMRABGDT
- IF $PIECE(GMRAZ,U)'>GMRAENDT
- Begin DoDot:2
- +30 SET GMRADRG(1)=GMRAZ
- SET GMRAZ=0
- FOR
- SET GMRAZ=$ORDER(^UTILITY("PSIV",$JOB,GMRAY,"A",GMRAZ))
- if GMRAZ<1
- QUIT
- Begin DoDot:3
- +31 SET GMRADRG="IV"_U_$PIECE($PIECE(^UTILITY("PSIV",$JOB,GMRAY,"A",GMRAZ),U),";",2)_U_$PIECE(^(GMRAZ),U,2)
- +32 SET GMRADRG=GMRADRG_U_$PIECE(GMRADRG(1),U,5,6)_U_$PIECE(GMRADRG(1),U,1,2)
- +33 SET GMRARRAY("PH",GMRACT)=GMRADRG
- SET GMRACT=GMRACT+1
- +34 QUIT
- End DoDot:3
- +35 QUIT
- End DoDot:2
- +36 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 ;54
- IF GMRAFNVA
- Begin DoDot:1
- +29 ;54
- WRITE !,"There are Non-VA Meds on this patient's profile. Please review for possible"
- +30 ;54
- WRITE !,"manual inclusion in this report.",!
- +31 ;54
- QUIT
- End DoDot:1
- +32 KILL ^UTILITY("PSG",$JOB),^UTILITY("PSIV",$JOB),@(GMRAPHRG_"""PSOO"",$J)")
- +33 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