- GMRADSP5 ;HIRMFO/YMP,RM,WAA-LISTING OF ALLERGIES TO SIGNED OFF ALLERGIES ;8/16/92
- ;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5
- EN1 ; Entry to PATIENT ALLERGIES NOT SIGNED OFF option
- S GMRAOUT=0
- S GMRAHEAD(1)=$J("ALLERGY/ADVERSE REACTIONS TO BE SIGNED OFF",59),GMRAHEAD(4)=$J("ORIGINATOR",10)_$J("PATIENT",21)_$J("ALLERGY",19)_$J("ORIGINATION DATE/TIME",29),(GMRAHEAD(3),GMRAHEAD(5),GMRAHEAD(6))="",$P(GMRAHEAD(5),"-",81)=""
- S GMRANOW=$$NOW^XLFDT,GMRANOW=$$FMTE^XLFDT(GMRANOW,"2P")
- S GMRAHEAD(1.5)=$J("Run Date/Time: "_GMRANOW,55)
- K GMRAZIS D DEV^GMRAUTL I POP S GMRAOUT=1 G EXIT
- I $D(IO("Q")) D TASK G EXIT
- EN2 S (GMRAORG,GMRADT)=""
- F GMRAREC=0:0 S GMRAREC=$O(^GMR(120.8,"ASGN",GMRAREC)) Q:GMRAREC'>0 D EN2A
- G DISP
- Q
- EN2A S GMRATEMP=$G(^GMR(120.8,GMRAREC,0)) Q:GMRATEMP=""
- I '$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) Q:$P(GMRATEMP,U,5)'=DUZ
- Q:'$$PRDTST^GMRAUTL1($P(GMRATEMP,U)) ;GMRA*4*33 Exclude test patient if production or legacy environment.
- S DFN=$P(GMRATEMP,U) D PID^VADPT6 S GMRASSN=VA("BID") D KVA^VADPT
- I $P(GMRATEMP,U,5)'="" S ^TMP($J,"GMRADSP",$P(^VA(200,$P(GMRATEMP,U,5),0),U),$P(GMRATEMP,U,5),$P(GMRATEMP,U,4),$P(GMRATEMP,U),GMRAREC)=$P(GMRATEMP,U,2)_U_$E($P(^DPT($P(GMRATEMP,U),0),U),1,14)_"("_GMRASSN_")"
- Q
- DISP S GMRAPG=0 D HDR^GMRADSP3 W:'$D(^TMP($J,"GMRADSP")) !!!,?7,"NO DATA FOR THIS REPORT"
- S GMRAORG="" F S GMRAORG=$O(^TMP($J,"GMRADSP",GMRAORG)) Q:GMRAORG=""!GMRAOUT D Q:GMRAOUT
- .S GMRAIEN="" F S GMRAIEN=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN)) Q:GMRAIEN=""!GMRAOUT D Q:GMRAOUT
- ..S GMRADT="" F S GMRADT=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN,GMRADT)) Q:GMRADT=""!GMRAOUT D Q:GMRAOUT
- ...S GMRADFN="" F S GMRADFN=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN,GMRADT,GMRADFN)) Q:GMRADFN=""!GMRAOUT D EN3
- ...Q
- ..Q
- .Q
- EXIT ;Quit and kill
- D CLOSE^GMRAUTL
- K ^TMP($J,"GMRADSP"),X,Y,Z
- D KILL^XUSCLEAN
- Q
- EN3 S GMRAPAT="" F S GMRAPAT=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN,GMRADT,GMRADFN,GMRAPAT)) Q:GMRAPAT=""!GMRAOUT S GMRALL=$G(^(GMRAPAT)) I GMRALL'="" D Q:GMRAOUT
- .S Y=GMRADT D D^DIQ W !,$E(GMRAORG,1,15),?17,$P(GMRALL,U,2),?42,$E($P(GMRALL,U),1,16),?59,Y
- .D:IOSL-4<$Y EOP^GMRADSP3 Q:GMRAOUT
- .Q
- Q
- TASK ;
- S ZTDESC="Patient reactions not signed off",ZTRTN="EN2^GMRADSP5",ZTDTH="",ZTIO=ION,ZTSAVE("GMRA*")="",ZTSAVE("DFN")="" D ^%ZTLOAD
- W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...")
- K ZTRTN,ZTDH,ZTSAVE,ZTDTH,ZTSK
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRADSP5 2454 printed Feb 18, 2025@23:05:19 Page 2
- GMRADSP5 ;HIRMFO/YMP,RM,WAA-LISTING OF ALLERGIES TO SIGNED OFF ALLERGIES ;8/16/92
- +1 ;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5
- EN1 ; Entry to PATIENT ALLERGIES NOT SIGNED OFF option
- +1 SET GMRAOUT=0
- +2 SET GMRAHEAD(1)=$JUSTIFY("ALLERGY/ADVERSE REACTIONS TO BE SIGNED OFF",59)
- SET GMRAHEAD(4)=$JUSTIFY("ORIGINATOR",10)_$JUSTIFY("PATIENT",21)_$JUSTIFY("ALLERGY",19)_$JUSTIFY("ORIGINATION DATE/TIME",29)
- SET (GMRAHEAD(3),GMRAHEAD(5),GMRAHEAD(6))=""
- SET $PIECE(GMRAHEAD(5),"-",81)=""
- +3 SET GMRANOW=$$NOW^XLFDT
- SET GMRANOW=$$FMTE^XLFDT(GMRANOW,"2P")
- +4 SET GMRAHEAD(1.5)=$JUSTIFY("Run Date/Time: "_GMRANOW,55)
- +5 KILL GMRAZIS
- DO DEV^GMRAUTL
- IF POP
- SET GMRAOUT=1
- GOTO EXIT
- +6 IF $DATA(IO("Q"))
- DO TASK
- GOTO EXIT
- EN2 SET (GMRAORG,GMRADT)=""
- +1 FOR GMRAREC=0:0
- SET GMRAREC=$ORDER(^GMR(120.8,"ASGN",GMRAREC))
- if GMRAREC'>0
- QUIT
- DO EN2A
- +2 GOTO DISP
- +3 QUIT
- EN2A SET GMRATEMP=$GET(^GMR(120.8,GMRAREC,0))
- if GMRATEMP=""
- QUIT
- +1 IF '$DATA(^XUSEC("GMRA-ALLERGY VERIFY",DUZ))
- if $PIECE(GMRATEMP,U,5)'=DUZ
- QUIT
- +2 ;GMRA*4*33 Exclude test patient if production or legacy environment.
- if '$$PRDTST^GMRAUTL1($PIECE(GMRATEMP,U))
- QUIT
- +3 SET DFN=$PIECE(GMRATEMP,U)
- DO PID^VADPT6
- SET GMRASSN=VA("BID")
- DO KVA^VADPT
- +4 IF $PIECE(GMRATEMP,U,5)'=""
- SET ^TMP($JOB,"GMRADSP",$PIECE(^VA(200,$PIECE(GMRATEMP,U,5),0),U),$PIECE(GMRATEMP,U,5),$PIECE(GMRATEMP,U,4),$PIECE(GMRATEMP,U),GMRAREC)=$PIECE(GMRATEMP,U,2)_U_$EXTRACT($PIECE(^DPT($PIECE(GMRATEMP,U),0),U),1,14)_"("_GMRASSN_")"
- +5 QUIT
- DISP SET GMRAPG=0
- DO HDR^GMRADSP3
- if '$DATA(^TMP($JOB,"GMRADSP"))
- WRITE !!!,?7,"NO DATA FOR THIS REPORT"
- +1 SET GMRAORG=""
- FOR
- SET GMRAORG=$ORDER(^TMP($JOB,"GMRADSP",GMRAORG))
- if GMRAORG=""!GMRAOUT
- QUIT
- Begin DoDot:1
- +2 SET GMRAIEN=""
- FOR
- SET GMRAIEN=$ORDER(^TMP($JOB,"GMRADSP",GMRAORG,GMRAIEN))
- if GMRAIEN=""!GMRAOUT
- QUIT
- Begin DoDot:2
- +3 SET GMRADT=""
- FOR
- SET GMRADT=$ORDER(^TMP($JOB,"GMRADSP",GMRAORG,GMRAIEN,GMRADT))
- if GMRADT=""!GMRAOUT
- QUIT
- Begin DoDot:3
- +4 SET GMRADFN=""
- FOR
- SET GMRADFN=$ORDER(^TMP($JOB,"GMRADSP",GMRAORG,GMRAIEN,GMRADT,GMRADFN))
- if GMRADFN=""!GMRAOUT
- QUIT
- DO EN3
- +5 QUIT
- End DoDot:3
- if GMRAOUT
- QUIT
- +6 QUIT
- End DoDot:2
- if GMRAOUT
- QUIT
- +7 QUIT
- End DoDot:1
- if GMRAOUT
- QUIT
- EXIT ;Quit and kill
- +1 DO CLOSE^GMRAUTL
- +2 KILL ^TMP($JOB,"GMRADSP"),X,Y,Z
- +3 DO KILL^XUSCLEAN
- +4 QUIT
- EN3 SET GMRAPAT=""
- FOR
- SET GMRAPAT=$ORDER(^TMP($JOB,"GMRADSP",GMRAORG,GMRAIEN,GMRADT,GMRADFN,GMRAPAT))
- if GMRAPAT=""!GMRAOUT
- QUIT
- SET GMRALL=$GET(^(GMRAPAT))
- IF GMRALL'=""
- Begin DoDot:1
- +1 SET Y=GMRADT
- DO D^DIQ
- WRITE !,$EXTRACT(GMRAORG,1,15),?17,$PIECE(GMRALL,U,2),?42,$EXTRACT($PIECE(GMRALL,U),1,16),?59,Y
- +2 if IOSL-4<$Y
- DO EOP^GMRADSP3
- if GMRAOUT
- QUIT
- +3 QUIT
- End DoDot:1
- if GMRAOUT
- QUIT
- +4 QUIT
- TASK ;
- +1 SET ZTDESC="Patient reactions not signed off"
- SET ZTRTN="EN2^GMRADSP5"
- SET ZTDTH=""
- SET ZTIO=ION
- SET ZTSAVE("GMRA*")=""
- SET ZTSAVE("DFN")=""
- DO ^%ZTLOAD
- +2 WRITE !!,$SELECT($DATA(ZTSK):"Request queued...",1:"Request NOT queued please try later...")
- +3 KILL ZTRTN,ZTDH,ZTSAVE,ZTDTH,ZTSK
- +4 QUIT