- GMRAPST7 ;HIRMFO/WAA- ADVERSE DRUG REACTION REPORT ;3/5/97 15:17
- ;;4.0;Adverse Reaction Tracking;**7,33**;Mar 29, 1996;Build 5
- EN1 ; This routine will loop through the ADT entry point to get all
- ; the entries in that date range.
- S GMRAOUT=0
- W !,"Select an Observed date range for this report."
- D DT^GMRAPL G:GMRAOUT EXIT
- D PRINTER
- EXIT ; Exit of program kill cleanup
- D KILL^XUSCLEAN
- K ^TMP($J,"GMRAPST7")
- Q
- PRINTER ;Select printer
- W !!,"This report required a 132 column printer."
- K GMRAZIS S GMRAZIS="M132" D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
- I $D(IO("Q")) D Q
- . S ZTRTN="PRINT^GMRAPST7",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
- . S ZTDESC="P&T Committee ADR Report" D ^%ZTLOAD
- . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
- . Q
- U IO D PRINT U IO(0)
- Q
- PRINT ;Queue point for report
- ;loop through the 120.85 file and look for the field that
- K ^TMP($J,"GMRAPST7")
- D NOW^%DTC S GMRADPDT=X
- S GMRADATE=GMAST-.0001,GMRAPG=1
- F S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1 Q:GMRADATE>GMAEN D
- .S GMRAPA1=0 F S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1 D
- ..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)="" ;Bad Node
- ..S GMRADDT=$P(GMRAPA1(0),U) ; reaction date
- ..S GMRAPA=$P(GMRAPA1(0),U,15) ; Get the 120.8 entry for this reaction in 120.85
- ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)="" ; Bad node
- ..Q:+$G(^GMR(120.8,GMRAPA,"ER")) ;Entered in error data
- ..S GMRACA=$P(GMRAPA(0),U,2) ; Causative Agent
- ..S DFN=$P(GMRAPA(0),U),GMRACA=$E(GMRACA,1,22)_"-"_$E($P(^DPT(DFN,0),U),1)_$E($P(^(0),U,9),6,9)
- ..Q:'$$PRDTST^GMRAUTL1(DFN) ;GMRA*4*33 Exclude test patients from report if production or legacy environment.
- ..S ^TMP($J,"GMRAPST7",GMRADDT,GMRACA,GMRAPA1)=GMRAPA
- ..Q
- .Q
- Q:GMRAOUT
- I '$D(^TMP($J,"GMRAPST7")) D HEAD W !,"NO DATA FOR THIS REPORT..." Q
- S GMRAOTH=$G(GMRAOTH,$O(^GMRD(120.83,"B","OTHER REACTION",0)))
- S GMRADDT=0
- F S GMRADDT=$O(^TMP($J,"GMRAPST7",GMRADDT)) Q:GMRADDT<1 D Q:GMRAOUT
- .S GMRACA=""
- .F S GMRACA=$O(^TMP($J,"GMRAPST7",GMRADDT,GMRACA)) Q:GMRACA="" D Q:GMRAOUT
- ..S GMRAPA1=0
- ..F S GMRAPA1=$O(^TMP($J,"GMRAPST7",GMRADDT,GMRACA,GMRAPA1)) Q:GMRAPA1<1 D Q:GMRAOUT
- ...S GMRAPA=$G(^TMP($J,"GMRAPST7",GMRADDT,GMRACA,GMRAPA1))
- ...Q:GMRAPA=""
- ...S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0))
- ...Q:GMRAPA1(0)=""
- ...S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
- ...Q:GMRAPA(0)=""
- ...D HEAD Q:GMRAOUT
- ...W !,$J($$FMTE^XLFDT(GMRADDT,"2D"),8) ; Obs Date
- ...W ?8,"|",GMRACA ; Causative Agent
- ...W ?38,"|"
- ...S GMRAREC=0
- ...S GMRAREC=$O(^GMR(120.85,GMRAPA1,2,0)) D:GMRAREC>0 SIGN("0",GMRAREC)
- ...W ?58,"| " W $P(GMRAPA(0),U,14) ; Mechanism
- ...W ?63,"|" W $S($P(GMRAPA1(0),U,14)=1:"MILD",$P(GMRAPA1(0),U,14)=2:"MOD.",$P(GMRAPA1(0),U,14)=3:"SVR.",1:"") ; Severity
- ...W ?68,"|"
- ...K ^TMP($J,"GMRAWORD") D WORD^GMRAWORD(GMRAPA,"OVE",60)
- ...S GMRACNT=1 W $G(^TMP($J,"GMRAWORD",GMRACNT))
- ...F S GMRAREC=$O(^GMR(120.85,GMRAPA1,2,GMRAREC)) Q:GMRAREC<1 D SIGN("1",GMRAREC) Q:GMRAOUT
- ...F S GMRACNT=$O(^TMP($J,"GMRAWORD",GMRACNT)) Q:GMRACNT<1 D Q:GMRAOUT
- ....D HEAD Q:GMRAOUT W !,?8,"|",?38,"|",?58,"|",?63,"|",?68,"|"
- ....Q:GMRAOUT
- ....W $G(^TMP($J,"GMRAWORD",GMRACNT))
- ....Q
- ...K ^TMP($J,"GMRAWORD")
- ...Q:GMRAOUT
- ...D HEAD Q:GMRAOUT W !,?8,"|",?38,"|",?58,"|",?63,"|",?68,"|"
- ...Q
- ..Q
- .Q
- D CLOSE^GMRAUTL
- Q
- SIGN(CNT,GMRAREC) ; Print Sign/Symptoms
- N NAM,Y
- S Y=$G(^GMR(120.85,GMRAPA1,2,GMRAREC,0))
- S NAM=$S(+Y=GMRAOTH:$P(Y,U,2),$D(^GMRD(120.83,+Y,0)):$P(^GMRD(120.83,+Y,0),U),1:"")
- I 'CNT W $E(NAM,1,19)
- E D
- .D HEAD Q:GMRAOUT W !,?8,"|",?38,"|",$E(NAM,1,19),?58,"|",?63,"|",?68,"|"
- .I $D(^TMP($J,"GMRAWORD",(GMRACNT+1))) S GMRACNT=GMRACNT+1 W $G(^TMP($J,"GMRAWORD",GMRACNT))
- .Q
- Q
- HEAD ; Print header information
- I GMRAPG'=1 Q:$Y<(IOSL-4)
- I $E(IOST,1)="C" D Q:GMRAOUT
- .I GMRAPG=1 W @IOF Q
- .I GMRAPG'=1 D Q:GMRAOUT
- ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
- ..K Y
- ..Q
- .Q
- Q:GMRAOUT
- I GMRAPG'=1 W @IOF
- N Z
- W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?125,"Page: ",GMRAPG
- W !,?48,"P&T Committee ADR Report"
- W !,?51,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D")
- W !,$$REPEAT^XLFSTR("-",130)
- W !,"Obsv.",?8,"|",?38,"|",?58,"|ADR",?63,"|ADR",?68,"|"
- W !,"Date",?8,"|Causative agent-Pat. ID",?38,"|Sign/Symptoms",?58,"|Mech",?63,"|Svr.",?68,"|Comments"
- W !,$$REPEAT^XLFSTR("-",130)
- S GMRAPG=GMRAPG+1
- I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAPST7 4618 printed Jan 18, 2025@02:41:35 Page 2
- GMRAPST7 ;HIRMFO/WAA- ADVERSE DRUG REACTION REPORT ;3/5/97 15:17
- +1 ;;4.0;Adverse Reaction Tracking;**7,33**;Mar 29, 1996;Build 5
- EN1 ; This routine will loop through the ADT entry point to get all
- +1 ; the entries in that date range.
- +2 SET GMRAOUT=0
- +3 WRITE !,"Select an Observed date range for this report."
- +4 DO DT^GMRAPL
- if GMRAOUT
- GOTO EXIT
- +5 DO PRINTER
- EXIT ; Exit of program kill cleanup
- +1 DO KILL^XUSCLEAN
- +2 KILL ^TMP($JOB,"GMRAPST7")
- +3 QUIT
- PRINTER ;Select printer
- +1 WRITE !!,"This report required a 132 column printer."
- +2 KILL GMRAZIS
- SET GMRAZIS="M132"
- DO DEV^GMRAUTL
- IF POP
- WRITE !,"PLEASE TRY LATER"
- SET GMRAOUT=1
- QUIT
- +3 IF $DATA(IO("Q"))
- Begin DoDot:1
- +4 SET ZTRTN="PRINT^GMRAPST7"
- SET (ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
- +5 SET ZTDESC="P&T Committee ADR Report"
- DO ^%ZTLOAD
- +6 WRITE !!,$SELECT($DATA(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
- +7 QUIT
- End DoDot:1
- QUIT
- +8 USE IO
- DO PRINT
- USE IO(0)
- +9 QUIT
- PRINT ;Queue point for report
- +1 ;loop through the 120.85 file and look for the field that
- +2 KILL ^TMP($JOB,"GMRAPST7")
- +3 DO NOW^%DTC
- SET GMRADPDT=X
- +4 SET GMRADATE=GMAST-.0001
- SET GMRAPG=1
- +5 FOR
- SET GMRADATE=$ORDER(^GMR(120.85,"B",GMRADATE))
- if GMRADATE<1
- QUIT
- if GMRADATE>GMAEN
- QUIT
- Begin DoDot:1
- +6 SET GMRAPA1=0
- FOR
- SET GMRAPA1=$ORDER(^GMR(120.85,"B",GMRADATE,GMRAPA1))
- if GMRAPA1<1
- QUIT
- Begin DoDot:2
- +7 ;Bad Node
- SET GMRAPA1(0)=$GET(^GMR(120.85,GMRAPA1,0))
- if GMRAPA1(0)=""
- QUIT
- +8 ; reaction date
- SET GMRADDT=$PIECE(GMRAPA1(0),U)
- +9 ; Get the 120.8 entry for this reaction in 120.85
- SET GMRAPA=$PIECE(GMRAPA1(0),U,15)
- +10 ; Bad node
- SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
- if GMRAPA(0)=""
- QUIT
- +11 ;Entered in error data
- if +$GET(^GMR(120.8,GMRAPA,"ER"))
- QUIT
- +12 ; Causative Agent
- SET GMRACA=$PIECE(GMRAPA(0),U,2)
- +13 SET DFN=$PIECE(GMRAPA(0),U)
- SET GMRACA=$EXTRACT(GMRACA,1,22)_"-"_$EXTRACT($PIECE(^DPT(DFN,0),U),1)_$EXTRACT($PIECE(^(0),U,9),6,9)
- +14 ;GMRA*4*33 Exclude test patients from report if production or legacy environment.
- if '$$PRDTST^GMRAUTL1(DFN)
- QUIT
- +15 SET ^TMP($JOB,"GMRAPST7",GMRADDT,GMRACA,GMRAPA1)=GMRAPA
- +16 QUIT
- End DoDot:2
- +17 QUIT
- End DoDot:1
- +18 if GMRAOUT
- QUIT
- +19 IF '$DATA(^TMP($JOB,"GMRAPST7"))
- DO HEAD
- WRITE !,"NO DATA FOR THIS REPORT..."
- QUIT
- +20 SET GMRAOTH=$GET(GMRAOTH,$ORDER(^GMRD(120.83,"B","OTHER REACTION",0)))
- +21 SET GMRADDT=0
- +22 FOR
- SET GMRADDT=$ORDER(^TMP($JOB,"GMRAPST7",GMRADDT))
- if GMRADDT<1
- QUIT
- Begin DoDot:1
- +23 SET GMRACA=""
- +24 FOR
- SET GMRACA=$ORDER(^TMP($JOB,"GMRAPST7",GMRADDT,GMRACA))
- if GMRACA=""
- QUIT
- Begin DoDot:2
- +25 SET GMRAPA1=0
- +26 FOR
- SET GMRAPA1=$ORDER(^TMP($JOB,"GMRAPST7",GMRADDT,GMRACA,GMRAPA1))
- if GMRAPA1<1
- QUIT
- Begin DoDot:3
- +27 SET GMRAPA=$GET(^TMP($JOB,"GMRAPST7",GMRADDT,GMRACA,GMRAPA1))
- +28 if GMRAPA=""
- QUIT
- +29 SET GMRAPA1(0)=$GET(^GMR(120.85,GMRAPA1,0))
- +30 if GMRAPA1(0)=""
- QUIT
- +31 SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
- +32 if GMRAPA(0)=""
- QUIT
- +33 DO HEAD
- if GMRAOUT
- QUIT
- +34 ; Obs Date
- WRITE !,$JUSTIFY($$FMTE^XLFDT(GMRADDT,"2D"),8)
- +35 ; Causative Agent
- WRITE ?8,"|",GMRACA
- +36 WRITE ?38,"|"
- +37 SET GMRAREC=0
- +38 SET GMRAREC=$ORDER(^GMR(120.85,GMRAPA1,2,0))
- if GMRAREC>0
- DO SIGN("0",GMRAREC)
- +39 ; Mechanism
- WRITE ?58,"| "
- WRITE $PIECE(GMRAPA(0),U,14)
- +40 ; Severity
- WRITE ?63,"|"
- WRITE $SELECT($PIECE(GMRAPA1(0),U,14)=1:"MILD",$PIECE(GMRAPA1(0),U,14)=2:"MOD.",$PIECE(GMRAPA1(0),U,14)=3:"SVR.",1:"")
- +41 WRITE ?68,"|"
- +42 KILL ^TMP($JOB,"GMRAWORD")
- DO WORD^GMRAWORD(GMRAPA,"OVE",60)
- +43 SET GMRACNT=1
- WRITE $GET(^TMP($JOB,"GMRAWORD",GMRACNT))
- +44 FOR
- SET GMRAREC=$ORDER(^GMR(120.85,GMRAPA1,2,GMRAREC))
- if GMRAREC<1
- QUIT
- DO SIGN("1",GMRAREC)
- if GMRAOUT
- QUIT
- +45 FOR
- SET GMRACNT=$ORDER(^TMP($JOB,"GMRAWORD",GMRACNT))
- if GMRACNT<1
- QUIT
- Begin DoDot:4
- +46 DO HEAD
- if GMRAOUT
- QUIT
- WRITE !,?8,"|",?38,"|",?58,"|",?63,"|",?68,"|"
- +47 if GMRAOUT
- QUIT
- +48 WRITE $GET(^TMP($JOB,"GMRAWORD",GMRACNT))
- +49 QUIT
- End DoDot:4
- if GMRAOUT
- QUIT
- +50 KILL ^TMP($JOB,"GMRAWORD")
- +51 if GMRAOUT
- QUIT
- +52 DO HEAD
- if GMRAOUT
- QUIT
- WRITE !,?8,"|",?38,"|",?58,"|",?63,"|",?68,"|"
- +53 QUIT
- End DoDot:3
- if GMRAOUT
- QUIT
- +54 QUIT
- End DoDot:2
- if GMRAOUT
- QUIT
- +55 QUIT
- End DoDot:1
- if GMRAOUT
- QUIT
- +56 DO CLOSE^GMRAUTL
- +57 QUIT
- SIGN(CNT,GMRAREC) ; Print Sign/Symptoms
- +1 NEW NAM,Y
- +2 SET Y=$GET(^GMR(120.85,GMRAPA1,2,GMRAREC,0))
- +3 SET NAM=$SELECT(+Y=GMRAOTH:$PIECE(Y,U,2),$DATA(^GMRD(120.83,+Y,0)):$PIECE(^GMRD(120.83,+Y,0),U),1:"")
- +4 IF 'CNT
- WRITE $EXTRACT(NAM,1,19)
- +5 IF '$TEST
- Begin DoDot:1
- +6 DO HEAD
- if GMRAOUT
- QUIT
- WRITE !,?8,"|",?38,"|",$EXTRACT(NAM,1,19),?58,"|",?63,"|",?68,"|"
- +7 IF $DATA(^TMP($JOB,"GMRAWORD",(GMRACNT+1)))
- SET GMRACNT=GMRACNT+1
- WRITE $GET(^TMP($JOB,"GMRAWORD",GMRACNT))
- +8 QUIT
- End DoDot:1
- +9 QUIT
- HEAD ; Print header information
- +1 IF GMRAPG'=1
- if $Y<(IOSL-4)
- QUIT
- +2 IF $EXTRACT(IOST,1)="C"
- Begin DoDot:1
- +3 IF GMRAPG=1
- WRITE @IOF
- QUIT
- +4 IF GMRAPG'=1
- Begin DoDot:2
- +5 NEW DIR
- SET DIR(0)="E"
- DO ^DIR
- IF 'Y
- SET GMRAOUT=1
- +6 KILL Y
- +7 QUIT
- End DoDot:2
- if GMRAOUT
- QUIT
- +8 QUIT
- End DoDot:1
- if GMRAOUT
- QUIT
- +9 if GMRAOUT
- QUIT
- +10 IF GMRAPG'=1
- WRITE @IOF
- +11 NEW Z
- +12 WRITE "Report Date: ",$PIECE($$FMTE^XLFDT(GMRADPDT),"@"),?125,"Page: ",GMRAPG
- +13 WRITE !,?48,"P&T Committee ADR Report"
- +14 WRITE !,?51,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D")
- +15 WRITE !,$$REPEAT^XLFSTR("-",130)
- +16 WRITE !,"Obsv.",?8,"|",?38,"|",?58,"|ADR",?63,"|ADR",?68,"|"
- +17 WRITE !,"Date",?8,"|Causative agent-Pat. ID",?38,"|Sign/Symptoms",?58,"|Mech",?63,"|Svr.",?68,"|Comments"
- +18 WRITE !,$$REPEAT^XLFSTR("-",130)
- +19 SET GMRAPG=GMRAPG+1
- +20 ; Check if stopped by user
- IF $DATA(ZTQUEUED)
- if $$STPCK^GMRAUTL1
- SET GMRAOUT=1
- +21 QUIT