GMTSPST5 ;HINES/RMS - TIU OBJECT FOR REMOTE ALLERGIES VIA RDI ;Aug 21, 2018@14:28
;;2.7;Health Summary;**94**;Oct 20, 1995;Build 41
;
;Reference to ORRDI1 supported by DBIA 4659
;Reference to ^XTMP("ORRDI","OUTAGE INFO" supported by DBIA 5440
;
ENHS ;ENTRY POINT FOR HEALTH SUMMARY OF REMOTE AND LOCAL ALLERGY/ADR DATA
N GMTSHDR,GMTSRET,GMTSALG,GMTSALGR,GMTSFAC,GMTSREAC,GMTSRDI,GMTSDOWN,GMTSSTAT,GMTSSMSG
Q:'$G(DFN)
S GMTSSMSG=""
;Track usage of this routine
D ADD^GMTSPSTR("GMTSPST5")
;
;Get Remote Allergy/ADR Data
D RMTALG
I GMTSSTAT=1 D
.F GMTSALG=1:1:GMTSRET D
.. S GMTSFAC=$G(^XTMP("ORRDI","ART",DFN,GMTSALG,"FACILITY",0))
.. S GMTSREAC=$G(^XTMP("ORRDI","ART",DFN,GMTSALG,"GMRALLERGY",0))
.. Q:$$YESCHK
.. Q:GMTSFAC']""!(GMTSREAC']"")
.. S GMTSFAC=$P(GMTSFAC,"^",2)
.. S GMTSREAC=$P(GMTSREAC,U,2)
.. S GMTSALGR(GMTSFAC,GMTSREAC)=""
.S GMTSRET=$O(^XTMP("ORRDI","ART",DFN,"ASSESSMENT",""),-1)
.F GMTSALG=1:1:+GMTSRET D
.. S GMTSFAC=$G(^XTMP("ORRDI","ART",DFN,"ASSESSMENT",GMTSALG,"FACILITY",0))
.. S GMTSREAC=$G(^XTMP("ORRDI","ART",DFN,"ASSESSMENT",GMTSALG))
.. Q:$$YESCHK
.. Q:GMTSFAC']""!(GMTSREAC']"")
.. S GMTSFAC=$P(GMTSFAC,"^",2)
.. S GMTSREAC=$P(GMTSREAC,U,2)
.. S GMTSALGR(GMTSFAC,GMTSREAC)=""
;
;Get Local Allergy/ADR Data
N LOCFAC S LOCFAC=$P($$SITE^VASITE,"^",2)
N GMI,GMRAL D EN1^GMRADPT
; HERE, 1=Allergy List, 0=NKA, NULL=No Assessment
I GMRAL=1 D
. S GMI=0 F S GMI=$O(GMRAL(GMI)) Q:GMI'>0 S GMTSALGR(LOCFAC,$P(GMRAL(GMI),U,2))=""
I GMRAL=0 D
. S GMTSALGR(LOCFAC,"No Known Allergies")=""
I GMRAL="" D
. S GMTSALGR(LOCFAC,"No Allergy Assessment Completed")=""
;
;Display HS Component
D CKP^GMTSUP Q:$D(GMTSQIT)
W !,"FACILITY",?40,"ALLERGY/ADR",!,"--------",?40,"-----------"
D CKP^GMTSUP Q:$D(GMTSQIT)
I GMTSSTAT=0 D ;Q ;Took out QUIT here so local allergy info can display
.D CKP^GMTSUP Q:$D(GMTSQIT)
.W !,GMTSSMSG
.D CKP^GMTSUP Q:$D(GMTSQIT)
S GMTSFAC="" F S GMTSFAC=$O(GMTSALGR(GMTSFAC)) Q:GMTSFAC']"" D ;
. S GMTSREAC="" F S GMTSREAC=$O(GMTSALGR(GMTSFAC,GMTSREAC)) Q:GMTSREAC']"" D ;
.. D CKP^GMTSUP Q:$D(GMTSQIT)
.. W !,$E(GMTSFAC,1,38),?40,GMTSREAC
.. D CKP^GMTSUP Q:$D(GMTSQIT)
W ! D CKP^GMTSUP Q:$D(GMTSQIT)
Q
;
RMTALG ;
;ZEXCEPT: GMTSDOWN,GMTSHDR,GMTSREAC,GMTSRET,GMTSSMSG,GMTSSTAT
S GMTSSTAT=0
S GMTSSMSG=""
S GMTSHDR=$$HAVEHDR^ORRDI1 I '+$G(GMTSHDR) D Q
. S GMTSSMSG="*** WARNING: Remote Data from HDR not available ***"
D Q:$G(GMTSDOWN)
. I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) H $$GET^XPAR("ALL","ORRDI PING FREQ")/2
. I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) S GMTSDOWN=1 D
.. S GMTSSMSG="*** WARNING: Connection to Remote Data Currently Down ***"
D ;RDI/HDR CALL ENCAPSULATION
. D SAVDEV^%ZISUTL("GMTSHFS")
. S GMTSRET=$$GET^ORRDI1(DFN,"ART")
. D USE^%ZISUTL("GMTSHFS")
. D RMDEV^%ZISUTL("GMTSHFS")
I GMTSRET=-1 D Q
. S GMTSSMSG="*** WARNING: Connection to Remote Data Not Available ***"
I '$D(^XTMP("ORRDI","ART",DFN))!('+GMTSRET) D Q
. I $D(^XTMP("ORRDI","ART",DFN,"ASSESSMENT")) S GMTSSTAT=1 Q
. S GMTSSMSG="No Remote Allergy/ADR Data available for this patient"
S GMTSSTAT=1
Q
;
YESCHK() ;DO NOT INCLUDE IF A 'YES' ASSESSMENT
I $P(GMTSREAC,U,2)'="YES" Q 0
I $P(GMTSREAC,U,2)="YES" I $P(GMTSREAC,U,3)["99VA8" Q 1
Q 1 ;STOP IF THERE IS ANY PROBLEMATIC DATA
;----------------------------------------------------------
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSPST5 3446 printed Sep 23, 2025@19:35:47 Page 2
GMTSPST5 ;HINES/RMS - TIU OBJECT FOR REMOTE ALLERGIES VIA RDI ;Aug 21, 2018@14:28
+1 ;;2.7;Health Summary;**94**;Oct 20, 1995;Build 41
+2 ;
+3 ;Reference to ORRDI1 supported by DBIA 4659
+4 ;Reference to ^XTMP("ORRDI","OUTAGE INFO" supported by DBIA 5440
+5 ;
ENHS ;ENTRY POINT FOR HEALTH SUMMARY OF REMOTE AND LOCAL ALLERGY/ADR DATA
+1 NEW GMTSHDR,GMTSRET,GMTSALG,GMTSALGR,GMTSFAC,GMTSREAC,GMTSRDI,GMTSDOWN,GMTSSTAT,GMTSSMSG
+2 if '$GET(DFN)
QUIT
+3 SET GMTSSMSG=""
+4 ;Track usage of this routine
+5 DO ADD^GMTSPSTR("GMTSPST5")
+6 ;
+7 ;Get Remote Allergy/ADR Data
+8 DO RMTALG
+9 IF GMTSSTAT=1
Begin DoDot:1
+10 FOR GMTSALG=1:1:GMTSRET
Begin DoDot:2
+11 SET GMTSFAC=$GET(^XTMP("ORRDI","ART",DFN,GMTSALG,"FACILITY",0))
+12 SET GMTSREAC=$GET(^XTMP("ORRDI","ART",DFN,GMTSALG,"GMRALLERGY",0))
+13 if $$YESCHK
QUIT
+14 if GMTSFAC']""!(GMTSREAC']"")
QUIT
+15 SET GMTSFAC=$PIECE(GMTSFAC,"^",2)
+16 SET GMTSREAC=$PIECE(GMTSREAC,U,2)
+17 SET GMTSALGR(GMTSFAC,GMTSREAC)=""
End DoDot:2
+18 SET GMTSRET=$ORDER(^XTMP("ORRDI","ART",DFN,"ASSESSMENT",""),-1)
+19 FOR GMTSALG=1:1:+GMTSRET
Begin DoDot:2
+20 SET GMTSFAC=$GET(^XTMP("ORRDI","ART",DFN,"ASSESSMENT",GMTSALG,"FACILITY",0))
+21 SET GMTSREAC=$GET(^XTMP("ORRDI","ART",DFN,"ASSESSMENT",GMTSALG))
+22 if $$YESCHK
QUIT
+23 if GMTSFAC']""!(GMTSREAC']"")
QUIT
+24 SET GMTSFAC=$PIECE(GMTSFAC,"^",2)
+25 SET GMTSREAC=$PIECE(GMTSREAC,U,2)
+26 SET GMTSALGR(GMTSFAC,GMTSREAC)=""
End DoDot:2
End DoDot:1
+27 ;
+28 ;Get Local Allergy/ADR Data
+29 NEW LOCFAC
SET LOCFAC=$PIECE($$SITE^VASITE,"^",2)
+30 NEW GMI,GMRAL
DO EN1^GMRADPT
+31 ; HERE, 1=Allergy List, 0=NKA, NULL=No Assessment
+32 IF GMRAL=1
Begin DoDot:1
+33 SET GMI=0
FOR
SET GMI=$ORDER(GMRAL(GMI))
if GMI'>0
QUIT
SET GMTSALGR(LOCFAC,$PIECE(GMRAL(GMI),U,2))=""
End DoDot:1
+34 IF GMRAL=0
Begin DoDot:1
+35 SET GMTSALGR(LOCFAC,"No Known Allergies")=""
End DoDot:1
+36 IF GMRAL=""
Begin DoDot:1
+37 SET GMTSALGR(LOCFAC,"No Allergy Assessment Completed")=""
End DoDot:1
+38 ;
+39 ;Display HS Component
+40 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+41 WRITE !,"FACILITY",?40,"ALLERGY/ADR",!,"--------",?40,"-----------"
+42 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+43 ;Q ;Took out QUIT here so local allergy info can display
IF GMTSSTAT=0
Begin DoDot:1
+44 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+45 WRITE !,GMTSSMSG
+46 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
End DoDot:1
+47 ;
SET GMTSFAC=""
FOR
SET GMTSFAC=$ORDER(GMTSALGR(GMTSFAC))
if GMTSFAC']""
QUIT
Begin DoDot:1
+48 ;
SET GMTSREAC=""
FOR
SET GMTSREAC=$ORDER(GMTSALGR(GMTSFAC,GMTSREAC))
if GMTSREAC']""
QUIT
Begin DoDot:2
+49 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+50 WRITE !,$EXTRACT(GMTSFAC,1,38),?40,GMTSREAC
+51 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
End DoDot:2
End DoDot:1
+52 WRITE !
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+53 QUIT
+54 ;
RMTALG ;
+1 ;ZEXCEPT: GMTSDOWN,GMTSHDR,GMTSREAC,GMTSRET,GMTSSMSG,GMTSSTAT
+2 SET GMTSSTAT=0
+3 SET GMTSSMSG=""
+4 SET GMTSHDR=$$HAVEHDR^ORRDI1
IF '+$GET(GMTSHDR)
Begin DoDot:1
+5 SET GMTSSMSG="*** WARNING: Remote Data from HDR not available ***"
End DoDot:1
QUIT
+6 Begin DoDot:1
+7 IF $DATA(^XTMP("ORRDI","OUTAGE INFO","DOWN"))
HANG $$GET^XPAR("ALL","ORRDI PING FREQ")/2
+8 IF $DATA(^XTMP("ORRDI","OUTAGE INFO","DOWN"))
SET GMTSDOWN=1
Begin DoDot:2
+9 SET GMTSSMSG="*** WARNING: Connection to Remote Data Currently Down ***"
End DoDot:2
End DoDot:1
if $GET(GMTSDOWN)
QUIT
+10 ;RDI/HDR CALL ENCAPSULATION
Begin DoDot:1
+11 DO SAVDEV^%ZISUTL("GMTSHFS")
+12 SET GMTSRET=$$GET^ORRDI1(DFN,"ART")
+13 DO USE^%ZISUTL("GMTSHFS")
+14 DO RMDEV^%ZISUTL("GMTSHFS")
End DoDot:1
+15 IF GMTSRET=-1
Begin DoDot:1
+16 SET GMTSSMSG="*** WARNING: Connection to Remote Data Not Available ***"
End DoDot:1
QUIT
+17 IF '$DATA(^XTMP("ORRDI","ART",DFN))!('+GMTSRET)
Begin DoDot:1
+18 IF $DATA(^XTMP("ORRDI","ART",DFN,"ASSESSMENT"))
SET GMTSSTAT=1
QUIT
+19 SET GMTSSMSG="No Remote Allergy/ADR Data available for this patient"
End DoDot:1
QUIT
+20 SET GMTSSTAT=1
+21 QUIT
+22 ;
YESCHK() ;DO NOT INCLUDE IF A 'YES' ASSESSMENT
+1 IF $PIECE(GMTSREAC,U,2)'="YES"
QUIT 0
+2 IF $PIECE(GMTSREAC,U,2)="YES"
IF $PIECE(GMTSREAC,U,3)["99VA8"
QUIT 1
+3 ;STOP IF THERE IS ANY PROBLEMATIC DATA
QUIT 1
+4 ;----------------------------------------------------------
