- GMRAPU ;HIRMFO/WAA- PRINT ALLERGY LIST BY LOCATION UNVERIFIED ;8/27/93
- ;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5
- EN1 ; This routine will loop through the GMRA patient allergy file (120.8)
- ; to find all patients with unverified reactions
- ;
- S GMRAOUT=0 D PRINTER
- EXIT ; Exit of program kill cleanup
- D KILL^XUSCLEAN
- K ^TMP($J,"GMRAPU")
- Q
- PRINTER ;Select printer
- W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
- I $D(IO("Q")) D Q
- . S ZTRTN="PRINT^GMRAPU",ZTSAVE("GMRAOUT")=""
- . S ZTDESC="List of Unverified Reactions by Ward Location" 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
- K ^TMP($J,"GMRAPU") D FIND
- REPORT ; Print out the report
- S GMRAOUT=$G(GMRAOUT)
- S GMALOC="",GMRAPG=1,GMRADATE=$$NOW^XLFDT
- I '$D(^TMP($J,"GMRAPU")) D HEAD W !,?20,"NO DATA FOR THIS REPORT"
- F S GMALOC=$O(^TMP($J,"GMRAPU",GMALOC)) Q:GMALOC="" D HEAD Q:GMRAOUT D Q:GMRAOUT
- .S GMRANAM="" F S GMRANAM=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM)) Q:GMRANAM="" D Q:GMRAOUT
- ..S GMADFN=0 F S GMADFN=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN)) Q:GMADFN<1 D Q:GMRAOUT
- ...S GMRASSN="",GMRARB=""
- ...D VAD^GMRAUTL1(GMADFN,"","","","",.GMRASSN,.GMRARB)
- ...W !,GMRARB,$S(GMRARB'="":" ",1:""),GMRANAM," (",GMRASSN,")"
- ...S GMADT=0 F S GMADT=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN,GMADT)) Q:GMADT<1 S GMRAPA=0 F S GMRAPA=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN,GMADT,GMRAPA)) Q:GMRAPA<1 D Q:GMRAOUT
- ....S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
- ....Q:GMRAPA(0)=""
- ....W !,?3,$$FMTE^XLFDT(GMADT,"1")
- ....W ?30,$S($P(GMRAPA(0),U,5)'="":$E($P($G(^VA(200,$P(GMRAPA(0),U,5),0)),U),1,24),1:"<None>")
- ....W ?55,$E($P(GMRAPA(0),U,2),1,24)
- ....I $Y>(IOSL-4) D HEAD
- ....Q
- ...Q
- ..Q
- .Q
- D CLOSE^GMRAUTL
- Q
- HEAD ; Print header information
- 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
- W "Report Date: ",$P($$FMTE^XLFDT(GMRADATE),"@"),?70,"Page: ",GMRAPG
- W !,?19,"List of Unverified Reactions by Ward Location"
- W !,?30,"Ward Location: ",GMALOC
- W !,?3,"Origination Date/Time",?30,"Originator",?55,"Reaction"
- W !,$$REPEAT^XLFSTR("-",78)
- S GMRAPG=GMRAPG+1
- I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
- Q
- FIND ; This subroutines will build the data for the report.
- N GMADFN
- S GMADFN=0
- F S GMADFN=$O(^GMR(120.8,"AVER",GMADFN)) Q:GMADFN<1 D
- .N GMRALOC,GMRANAM,GMALOC,GMRAPA
- .S GMRANAM="",GMRALOC=""
- .Q:'$$PRDTST^GMRAUTL1(GMADFN) ;GMRA*4*33 Exclude test patients if production or legacy environment.
- .D VAD^GMRAUTL1(GMADFN,"",.GMRALOC,.GMRANAM,"","","") I GMRALOC="" S GMALOC="OUTPATIENT"
- .E S GMALOC=$P($G(^DIC(42,GMRALOC,0)),U)
- .Q:GMALOC=""
- .S GMRAPA=0
- .F S GMRAPA=$O(^GMR(120.8,"AVER",GMADFN,GMRAPA)) Q:GMRAPA<1 D
- ..N GMADT
- ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
- ..S GMADT=$P(GMRAPA(0),U,4)
- ..S ^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN,GMADT,GMRAPA)=""
- ..Q
- .Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAPU 3167 printed Feb 18, 2025@23:06:47 Page 2
- GMRAPU ;HIRMFO/WAA- PRINT ALLERGY LIST BY LOCATION UNVERIFIED ;8/27/93
- +1 ;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5
- EN1 ; This routine will loop through the GMRA patient allergy file (120.8)
- +1 ; to find all patients with unverified reactions
- +2 ;
- +3 SET GMRAOUT=0
- DO PRINTER
- EXIT ; Exit of program kill cleanup
- +1 DO KILL^XUSCLEAN
- +2 KILL ^TMP($JOB,"GMRAPU")
- +3 QUIT
- PRINTER ;Select printer
- +1 WRITE !
- KILL GMRAZIS
- DO DEV^GMRAUTL
- IF POP
- WRITE !,"PLEASE TRY LATER"
- SET GMRAOUT=1
- QUIT
- +2 IF $DATA(IO("Q"))
- Begin DoDot:1
- +3 SET ZTRTN="PRINT^GMRAPU"
- SET ZTSAVE("GMRAOUT")=""
- +4 SET ZTDESC="List of Unverified Reactions by Ward Location"
- DO ^%ZTLOAD
- +5 WRITE !!,$SELECT($DATA(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
- +6 QUIT
- End DoDot:1
- QUIT
- +7 USE IO
- DO PRINT
- USE IO(0)
- +8 QUIT
- PRINT ;Queue point for report
- +1 KILL ^TMP($JOB,"GMRAPU")
- DO FIND
- REPORT ; Print out the report
- +1 SET GMRAOUT=$GET(GMRAOUT)
- +2 SET GMALOC=""
- SET GMRAPG=1
- SET GMRADATE=$$NOW^XLFDT
- +3 IF '$DATA(^TMP($JOB,"GMRAPU"))
- DO HEAD
- WRITE !,?20,"NO DATA FOR THIS REPORT"
- +4 FOR
- SET GMALOC=$ORDER(^TMP($JOB,"GMRAPU",GMALOC))
- if GMALOC=""
- QUIT
- DO HEAD
- if GMRAOUT
- QUIT
- Begin DoDot:1
- +5 SET GMRANAM=""
- FOR
- SET GMRANAM=$ORDER(^TMP($JOB,"GMRAPU",GMALOC,GMRANAM))
- if GMRANAM=""
- QUIT
- Begin DoDot:2
- +6 SET GMADFN=0
- FOR
- SET GMADFN=$ORDER(^TMP($JOB,"GMRAPU",GMALOC,GMRANAM,GMADFN))
- if GMADFN<1
- QUIT
- Begin DoDot:3
- +7 SET GMRASSN=""
- SET GMRARB=""
- +8 DO VAD^GMRAUTL1(GMADFN,"","","","",.GMRASSN,.GMRARB)
- +9 WRITE !,GMRARB,$SELECT(GMRARB'="":" ",1:""),GMRANAM," (",GMRASSN,")"
- +10 SET GMADT=0
- FOR
- SET GMADT=$ORDER(^TMP($JOB,"GMRAPU",GMALOC,GMRANAM,GMADFN,GMADT))
- if GMADT<1
- QUIT
- SET GMRAPA=0
- FOR
- SET GMRAPA=$ORDER(^TMP($JOB,"GMRAPU",GMALOC,GMRANAM,GMADFN,GMADT,GMRAPA))
- if GMRAPA<1
- QUIT
- Begin DoDot:4
- +11 SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
- +12 if GMRAPA(0)=""
- QUIT
- +13 WRITE !,?3,$$FMTE^XLFDT(GMADT,"1")
- +14 WRITE ?30,$SELECT($PIECE(GMRAPA(0),U,5)'="":$EXTRACT($PIECE($GET(^VA(200,$PIECE(GMRAPA(0),U,5),0)),U),1,24),1:"<None>")
- +15 WRITE ?55,$EXTRACT($PIECE(GMRAPA(0),U,2),1,24)
- +16 IF $Y>(IOSL-4)
- DO HEAD
- +17 QUIT
- End DoDot:4
- if GMRAOUT
- QUIT
- +18 QUIT
- End DoDot:3
- if GMRAOUT
- QUIT
- +19 QUIT
- End DoDot:2
- if GMRAOUT
- QUIT
- +20 QUIT
- End DoDot:1
- if GMRAOUT
- QUIT
- +21 DO CLOSE^GMRAUTL
- +22 QUIT
- HEAD ; Print header information
- +1 IF $EXTRACT(IOST,1)="C"
- Begin DoDot:1
- +2 IF GMRAPG=1
- WRITE @IOF
- QUIT
- +3 IF GMRAPG'=1
- Begin DoDot:2
- +4 NEW DIR
- SET DIR(0)="E"
- DO ^DIR
- IF 'Y
- SET GMRAOUT=1
- +5 KILL Y
- +6 QUIT
- End DoDot:2
- if GMRAOUT
- QUIT
- +7 QUIT
- End DoDot:1
- if GMRAOUT
- QUIT
- +8 if GMRAOUT
- QUIT
- +9 IF GMRAPG'=1
- WRITE @IOF
- +10 WRITE "Report Date: ",$PIECE($$FMTE^XLFDT(GMRADATE),"@"),?70,"Page: ",GMRAPG
- +11 WRITE !,?19,"List of Unverified Reactions by Ward Location"
- +12 WRITE !,?30,"Ward Location: ",GMALOC
- +13 WRITE !,?3,"Origination Date/Time",?30,"Originator",?55,"Reaction"
- +14 WRITE !,$$REPEAT^XLFSTR("-",78)
- +15 SET GMRAPG=GMRAPG+1
- +16 ; Check if stopped by user
- IF $DATA(ZTQUEUED)
- if $$STPCK^GMRAUTL1
- SET GMRAOUT=1
- +17 QUIT
- FIND ; This subroutines will build the data for the report.
- +1 NEW GMADFN
- +2 SET GMADFN=0
- +3 FOR
- SET GMADFN=$ORDER(^GMR(120.8,"AVER",GMADFN))
- if GMADFN<1
- QUIT
- Begin DoDot:1
- +4 NEW GMRALOC,GMRANAM,GMALOC,GMRAPA
- +5 SET GMRANAM=""
- SET GMRALOC=""
- +6 ;GMRA*4*33 Exclude test patients if production or legacy environment.
- if '$$PRDTST^GMRAUTL1(GMADFN)
- QUIT
- +7 DO VAD^GMRAUTL1(GMADFN,"",.GMRALOC,.GMRANAM,"","","")
- IF GMRALOC=""
- SET GMALOC="OUTPATIENT"
- +8 IF '$TEST
- SET GMALOC=$PIECE($GET(^DIC(42,GMRALOC,0)),U)
- +9 if GMALOC=""
- QUIT
- +10 SET GMRAPA=0
- +11 FOR
- SET GMRAPA=$ORDER(^GMR(120.8,"AVER",GMADFN,GMRAPA))
- if GMRAPA<1
- QUIT
- Begin DoDot:2
- +12 NEW GMADT
- +13 SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
- if GMRAPA(0)=""
- QUIT
- +14 SET GMADT=$PIECE(GMRAPA(0),U,4)
- +15 SET ^TMP($JOB,"GMRAPU",GMALOC,GMRANAM,GMADFN,GMADT,GMRAPA)=""
- +16 QUIT
- End DoDot:2
- +17 QUIT
- End DoDot:1
- +18 QUIT