- GMRAFDA1 ;HIRMFO/WAA-SELECT PATIENT AND PRINTER FOR REPORTS PRINT OUT ;12/1/95 11:23
- ;;4.0;Adverse Reaction Tracking;**2**;Mar 29, 1996
- EN1 ;Entry to PRINT AN FDA REPORT FOR A PATIENT option
- S GMRAOUT=0,GMRALAGO=0 D EN1^GMRAU85 G:GMRAPA1'>0 EXIT
- S GMRANAM=$P($G(^DPT($P(GMRAPA(0),U),0)),U)
- D DEV1
- D EXIT
- Q
- DEV1 W !,"THIS REPORT SHOULD BE SENT TO A 132 COLUMN PRINTER.",!
- S GMRAZIS="QM132S60" D DEV^GMRAUTL I POP W !,"PLEASE TRY AGAIN LATER" S GMRAOUT=1 Q
- I $D(IO("Q")) D Q
- .S ZTSAVE("GMRAPA1")="",ZTRTN="PRINT^GMRAFDA1",ZTDESC="Produce FDA Report for "_GMRANAM
- .D ^%ZTLOAD K IO("Q")
- .W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...")
- .Q
- D PRINT Q
- Q
- PRINT ; ENTRY POINT TO BEGIN PRINTING THIS REPORT
- U IO D PRT U IO(0)
- D CLOSE^GMRAUTL
- Q
- PRT D ^GMRAFN1
- I $D(^TMP($J,"GMR")) D PRINT2 W @IOF
- Q
- PRINT2 ;PRINT THE SECOND PAGE OF ANY REMAINING DATA
- D ;HEADER INFORMATION
- .N GMRASUS,GMRATAB
- .W !,"ATTACHMENT PAGE"
- .W !,"PATIENT ID: ",GMRAID
- .S GMRASUS=$P(GMRAPA1(0),U,15)
- .I GMRASUS>0 S GMRATAB=66-((20+$L($P($G(^GMR(120.8,GMRASUS,0)),U,2)))/2) W ?GMRATAB,"SUSPECT MEDICATION: ",$P($G(^GMR(120.8,GMRASUS,0)),U,2)
- .W ?100,"DATE OF EVENT: ",$$FMTE^XLFDT($P(GMRAPA1(0),U),2)
- .Q
- I $D(^TMP($J,"GMR","R")) D
- .W ! F I=1:1:132 W "-"
- .W !,"Section B. Part 5. Describe event Continued" S GMRAX=0
- .S DIWL=5,DIWR=128,DIWF="" K ^UTILITY($J,"W",5) S GMRAX=0 ;D K ^UTILITY($J,"W",5)
- .F S GMRAX=$O(^TMP($J,"GMR","R",GMRAX)) Q:GMRAX<1 S X=^TMP($J,"GMR","R",GMRAX) D ^DIWP
- .K ^TMP($J,"GMR","R")
- .S X=0 F S X=$O(^UTILITY($J,"W",5,X)) Q:X<1 S ^TMP($J,"GMR","R",X)=$G(^UTILITY($J,"W",5,X,0))
- .F S GMRAX=$O(^TMP($J,"GMR","R",GMRAX)) Q:GMRAX<1 D Q:GMRAOUT
- ..W !,$S($D(^TMP($J,"GMR","R",GMRAX+1)):^TMP($J,"GMR","R",GMRAX),1:$E(^TMP($J,"GMR","R",GMRAX),1,($L(^TMP($J,"GMR","R",GMRAX))-2)))
- ..Q
- .Q
- I $D(^TMP($J,"GMR","T")) D
- .W ! F I=1:1:132 W "-"
- .W !,"Section B. Part 6. Relevant Test/Laboratory Data Continued:"
- .S GMRAX=0 F S GMRAX=$O(^TMP($J,"GMR","T",GMRAX)) Q:GMRAX'>0 D Q:GMRAOUT
- ..W !,"TEST: ",$P(^TMP($J,"GMR","T",GMRAX),U)," RESULTS: ",$P(^(GMRAX),U,2) S Y=$P(^(GMRAX),U,3) W:Y'="" " COLLECTION DATE: ",$$FMTE^XLFDT(Y,"2") K Y
- ..Q
- .Q
- I $D(^TMP($J,"GMR","O")) D
- .S DIWL=5,DIWR=128,DIWF="" K ^UTILITY($J,"W",5) S GMRAX=0 ;D K ^UTILITY($J,"W",5)
- .F S GMRAX=$O(^TMP($J,"GMR","O",GMRAX)) Q:GMRAX<1 S X=^TMP($J,"GMR","O",GMRAX) D ^DIWP
- .K ^TMP($J,"GMR","O")
- .S X=0 F S X=$O(^UTILITY($J,"W",5,X)) Q:X<1 S ^TMP($J,"GMR","O",X)=$G(^UTILITY($J,"W",5,X,0))
- .W ! F I=1:1:132 W "-"
- .W !,"Section B. Part 7. Other Relevant History Continued" S GMRAX=0
- .F S GMRAX=$O(^TMP($J,"GMR","O",GMRAX)) Q:GMRAX<1 D Q:GMRAOUT
- ..W !,^TMP($J,"GMR","O",GMRAX)
- ..Q
- .Q
- I $D(^TMP($J,"GMR","C")) D
- .W ! F I=1:1:132 W "-"
- .W !,"Section C. Part 10. Concomitant Drugs Continued" S GMRAX=0
- .F S GMRAX=$O(^TMP($J,"GMR","C",GMRAX)) Q:GMRAX<1 D Q:GMRAOUT
- ..W !,$P(^TMP($J,"GMR","C",GMRAX),"^"),?60 S X=$P(^(GMRAX),"^",2) W:X]"" $E(X,4,5),"/",$E(X,6,7),"/",$E(X,2,3) S X=$P(^(GMRAX),"^",3) W:X]"" "-",$E(X,4,5),"/",$E(X,6,7),"/",$E(X,2,3)
- ..Q
- .Q
- Q
- EXIT ;
- K ^TMP($J,"GMR")
- D KILL^XUSCLEAN
- Q
- LKP ; ADDITIONAL LOOKUP ON 120.85
- N GMRA S GMRA=$G(^GMR(120.85,+Y,0))
- I $P(GMRA,U)'="" W " ",$$FMTE^XLFDT($P(^GMR(120.85,+Y,0),U),"2S")
- I $P(GMRA,U,15)'="" W " ",$P($G(^GMR(120.8,$P(GMRA,U,15),0)),U,2)
- W $E(@(DIC_+Y_",0)"),0)
- Q
- SET ; set up variables for question mark help
- S X=GMRANAM,DLAYGO=120.85,DIC="^GMR(120.85,",DIC(0)="E",D="D",DIC("W")="D LKP^GMRAFDA1",DZ="??"
- S DIC("S")="I $P(^(0),U,2)=DFN S GMRA1208=+$P(^(0),U,15) I $$ERCHK^GMRAFDA1"
- Q
- ERCHK() ; check for "ER" node to screen out entered-in-error entries
- I '$D(^GMR(120.8,+GMRA1208,0)) Q 1
- I '$D(^GMR(120.8,+GMRA1208,"ER")) Q 1
- Q 0
- GMRAFDA1 ;HIRMFO/WAA-SELECT PATIENT AND PRINTER FOR REPORTS PRINT OUT ;12/1/95 11:23
- +1 ;;4.0;Adverse Reaction Tracking;**2**;Mar 29, 1996
- EN1 ;Entry to PRINT AN FDA REPORT FOR A PATIENT option
- +1 SET GMRAOUT=0
- SET GMRALAGO=0
- DO EN1^GMRAU85
- IF GMRAPA1'>0
- GOTO EXIT
- +2 SET GMRANAM=$PIECE($GET(^DPT($PIECE(GMRAPA(0),U),0)),U)
- +3 DO DEV1
- +4 DO EXIT
- +5 QUIT
- DEV1 WRITE !,"THIS REPORT SHOULD BE SENT TO A 132 COLUMN PRINTER.",!
- +1 SET GMRAZIS="QM132S60"
- DO DEV^GMRAUTL
- IF POP
- WRITE !,"PLEASE TRY AGAIN LATER"
- SET GMRAOUT=1
- QUIT
- +2 IF $DATA(IO("Q"))
- Begin DoDot:1
- +3 SET ZTSAVE("GMRAPA1")=""
- SET ZTRTN="PRINT^GMRAFDA1"
- SET ZTDESC="Produce FDA Report for "_GMRANAM
- +4 DO ^%ZTLOAD
- KILL IO("Q")
- +5 WRITE !!,$SELECT($DATA(ZTSK):"Request queued...",1:"Request NOT queued please try later...")
- +6 QUIT
- End DoDot:1
- QUIT
- +7 DO PRINT
- QUIT
- +8 QUIT
- PRINT ; ENTRY POINT TO BEGIN PRINTING THIS REPORT
- +1 USE IO
- DO PRT
- USE IO(0)
- +2 DO CLOSE^GMRAUTL
- +3 QUIT
- PRT DO ^GMRAFN1
- +1 IF $DATA(^TMP($JOB,"GMR"))
- DO PRINT2
- WRITE @IOF
- +2 QUIT
- PRINT2 ;PRINT THE SECOND PAGE OF ANY REMAINING DATA
- +1 ;HEADER INFORMATION
- Begin DoDot:1
- +2 NEW GMRASUS,GMRATAB
- +3 WRITE !,"ATTACHMENT PAGE"
- +4 WRITE !,"PATIENT ID: ",GMRAID
- +5 SET GMRASUS=$PIECE(GMRAPA1(0),U,15)
- +6 IF GMRASUS>0
- SET GMRATAB=66-((20+$LENGTH($PIECE($GET(^GMR(120.8,GMRASUS,0)),U,2)))/2)
- WRITE ?GMRATAB,"SUSPECT MEDICATION: ",$PIECE($GET(^GMR(120.8,GMRASUS,0)),U,2)
- +7 WRITE ?100,"DATE OF EVENT: ",$$FMTE^XLFDT($PIECE(GMRAPA1(0),U),2)
- +8 QUIT
- End DoDot:1
- +9 IF $DATA(^TMP($JOB,"GMR","R"))
- Begin DoDot:1
- +10 WRITE !
- FOR I=1:1:132
- WRITE "-"
- +11 WRITE !,"Section B. Part 5. Describe event Continued"
- SET GMRAX=0
- +12 ;D K ^UTILITY($J,"W",5)
- SET DIWL=5
- SET DIWR=128
- SET DIWF=""
- KILL ^UTILITY($JOB,"W",5)
- SET GMRAX=0
- +13 FOR
- SET GMRAX=$ORDER(^TMP($JOB,"GMR","R",GMRAX))
- IF GMRAX<1
- QUIT
- SET X=^TMP($JOB,"GMR","R",GMRAX)
- DO ^DIWP
- +14 KILL ^TMP($JOB,"GMR","R")
- +15 SET X=0
- FOR
- SET X=$ORDER(^UTILITY($JOB,"W",5,X))
- IF X<1
- QUIT
- SET ^TMP($JOB,"GMR","R",X)=$GET(^UTILITY($JOB,"W",5,X,0))
- +16 FOR
- SET GMRAX=$ORDER(^TMP($JOB,"GMR","R",GMRAX))
- IF GMRAX<1
- QUIT
- Begin DoDot:2
- +17 WRITE !,$SELECT($DATA(^TMP($JOB,"GMR","R",GMRAX+1)):^TMP($JOB,"GMR","R",GMRAX),1:$EXTRACT(^TMP($JOB,"GMR","R",GMRAX),1,($LENGTH(^TMP($JOB,"GMR","R",GMRAX))-2)))
- +18 QUIT
- End DoDot:2
- IF GMRAOUT
- QUIT
- +19 QUIT
- End DoDot:1
- +20 IF $DATA(^TMP($JOB,"GMR","T"))
- Begin DoDot:1
- +21 WRITE !
- FOR I=1:1:132
- WRITE "-"
- +22 WRITE !,"Section B. Part 6. Relevant Test/Laboratory Data Continued:"
- +23 SET GMRAX=0
- FOR
- SET GMRAX=$ORDER(^TMP($JOB,"GMR","T",GMRAX))
- IF GMRAX'>0
- QUIT
- Begin DoDot:2
- +24 WRITE !,"TEST: ",$PIECE(^TMP($JOB,"GMR","T",GMRAX),U)," RESULTS: ",$PIECE(^(GMRAX),U,2)
- SET Y=$PIECE(^(GMRAX),U,3)
- IF Y'=""
- WRITE " COLLECTION DATE: ",$$FMTE^XLFDT(Y,"2")
- KILL Y
- +25 QUIT
- End DoDot:2
- IF GMRAOUT
- QUIT
- +26 QUIT
- End DoDot:1
- +27 IF $DATA(^TMP($JOB,"GMR","O"))
- Begin DoDot:1
- +28 ;D K ^UTILITY($J,"W",5)
- SET DIWL=5
- SET DIWR=128
- SET DIWF=""
- KILL ^UTILITY($JOB,"W",5)
- SET GMRAX=0
- +29 FOR
- SET GMRAX=$ORDER(^TMP($JOB,"GMR","O",GMRAX))
- IF GMRAX<1
- QUIT
- SET X=^TMP($JOB,"GMR","O",GMRAX)
- DO ^DIWP
- +30 KILL ^TMP($JOB,"GMR","O")
- +31 SET X=0
- FOR
- SET X=$ORDER(^UTILITY($JOB,"W",5,X))
- IF X<1
- QUIT
- SET ^TMP($JOB,"GMR","O",X)=$GET(^UTILITY($JOB,"W",5,X,0))
- +32 WRITE !
- FOR I=1:1:132
- WRITE "-"
- +33 WRITE !,"Section B. Part 7. Other Relevant History Continued"
- SET GMRAX=0
- +34 FOR
- SET GMRAX=$ORDER(^TMP($JOB,"GMR","O",GMRAX))
- IF GMRAX<1
- QUIT
- Begin DoDot:2
- +35 WRITE !,^TMP($JOB,"GMR","O",GMRAX)
- +36 QUIT
- End DoDot:2
- IF GMRAOUT
- QUIT
- +37 QUIT
- End DoDot:1
- +38 IF $DATA(^TMP($JOB,"GMR","C"))
- Begin DoDot:1
- +39 WRITE !
- FOR I=1:1:132
- WRITE "-"
- +40 WRITE !,"Section C. Part 10. Concomitant Drugs Continued"
- SET GMRAX=0
- +41 FOR
- SET GMRAX=$ORDER(^TMP($JOB,"GMR","C",GMRAX))
- IF GMRAX<1
- QUIT
- Begin DoDot:2
- +42 WRITE !,$PIECE(^TMP($JOB,"GMR","C",GMRAX),"^"),?60
- SET X=$PIECE(^(GMRAX),"^",2)
- IF X]""
- WRITE $EXTRACT(X,4,5),"/",$EXTRACT(X,6,7),"/",$EXTRACT(X,2,3)
- SET X=$PIECE(^(GMRAX),"^",3)
- IF X]""
- WRITE "-",$EXTRACT(X,4,5),"/",$EXTRACT(X,6,7),"/",$EXTRACT(X,2,3)
- +43 QUIT
- End DoDot:2
- IF GMRAOUT
- QUIT
- +44 QUIT
- End DoDot:1
- +45 QUIT
- EXIT ;
- +1 KILL ^TMP($JOB,"GMR")
- +2 DO KILL^XUSCLEAN
- +3 QUIT
- LKP ; ADDITIONAL LOOKUP ON 120.85
- +1 NEW GMRA
- SET GMRA=$GET(^GMR(120.85,+Y,0))
- +2 IF $PIECE(GMRA,U)'=""
- WRITE " ",$$FMTE^XLFDT($PIECE(^GMR(120.85,+Y,0),U),"2S")
- +3 IF $PIECE(GMRA,U,15)'=""
- WRITE " ",$PIECE($GET(^GMR(120.8,$PIECE(GMRA,U,15),0)),U,2)
- +4 WRITE $EXTRACT(@(DIC_+Y_",0)"),0)
- +5 QUIT
- SET ; set up variables for question mark help
- +1 SET X=GMRANAM
- SET DLAYGO=120.85
- SET DIC="^GMR(120.85,"
- SET DIC(0)="E"
- SET D="D"
- SET DIC("W")="D LKP^GMRAFDA1"
- SET DZ="??"
- +2 SET DIC("S")="I $P(^(0),U,2)=DFN S GMRA1208=+$P(^(0),U,15) I $$ERCHK^GMRAFDA1"
- +3 QUIT
- ERCHK() ; check for "ER" node to screen out entered-in-error entries
- +1 IF '$DATA(^GMR(120.8,+GMRA1208,0))
- QUIT 1
- +2 IF '$DATA(^GMR(120.8,+GMRA1208,"ER"))
- QUIT 1
- +3 QUIT 0
