PSOQRART ;HINES/RMS- TIU OBJECT FOR REMOTE ALLERGIES VIA RDI ; 30 Nov 2007 7:56 AM
;;7.0;OUTPATIENT PHARMACY;**294,411**;DEC 1997;Build 95
;
;Reference to CKP^GMTSUP supported by DBIA 4231
;References to ^ORRDI1 supported by DBIA 4659
;References to ^XTMP("ORRDI" supported by DBIA 4660
ENHS ;ENTRY POINT FOR HEALTH SUMMARY OF REMOTE ALLERGY/ADR DATA
N PSOQHDR,PSOQRET,PSOQART,PSOQRART,PSOQFAC,PSOQREAC,PSOQRDI,PSOQDOWN
Q:'$G(DFN)
S PSOQHDR=$$HAVEHDR^ORRDI1 I '+$G(PSOQHDR) D Q
. D CKP^GMTSUP Q:$D(GMTSQIT)
. W !,"Remote Data from HDR not available"
. D CKP^GMTSUP Q:$D(GMTSQIT)
D Q:$G(PSOQDOWN)
. I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) H $$GET^XPAR("ALL","ORRDI PING FREQ")/2
. I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) S PSOQDOWN=1 D
.. D CKP^GMTSUP Q:$D(GMTSQIT)
.. W !,"WARNING: Connection to Remote Data Currently Down",!
.. D CKP^GMTSUP Q:$D(GMTSQIT)
D ;RDI/HDR CALL ENCAPSULATION
. D SAVDEV^%ZISUTL("PSOQHFS")
. S PSOQRET=$$GET^ORRDI1(DFN,"ART")
. D USE^%ZISUTL("PSOQHFS")
. D RMDEV^%ZISUTL("PSOQHFS")
I PSOQRET=-1 D Q
. D CKP^GMTSUP Q:$D(GMTSQIT)
. W !,"Connection to Remote Data Not Available"
. D CKP^GMTSUP Q:$D(GMTSQIT)
I '$D(^XTMP("ORRDI","ART",DFN))!('+PSOQRET) D Q
. D CKP^GMTSUP Q:$D(GMTSQIT)
. W !,"No Remote Allergy/ADR Data available for this patient"
. D CKP^GMTSUP Q:$D(GMTSQIT)
D CKP^GMTSUP Q:$D(GMTSQIT)
W !,"FACILITY",?40,"ALLERGY/ADR",!,"--------",?40,"-----------"
D CKP^GMTSUP Q:$D(GMTSQIT)
F PSOQART=1:1:PSOQRET D
. S PSOQFAC=$G(^XTMP("ORRDI","ART",DFN,PSOQART,"FACILITY",0))
. S PSOQREAC=$G(^XTMP("ORRDI","ART",DFN,PSOQART,"GMRALLERGY",0))
. Q:$$YESCHK
. Q:PSOQFAC']""!(PSOQREAC']"")
. S PSOQREAC=$P(PSOQREAC,U,2)
. S PSOQRART(PSOQFAC,PSOQREAC)=""
S PSOQFAC="" F S PSOQFAC=$O(PSOQRART(PSOQFAC)) Q:PSOQFAC']"" D ;
. S PSOQREAC="" F S PSOQREAC=$O(PSOQRART(PSOQFAC,PSOQREAC)) Q:PSOQREAC']"" D ;
.. D CKP^GMTSUP Q:$D(GMTSQIT)
.. W !,PSOQFAC,?40,PSOQREAC
.. D CKP^GMTSUP Q:$D(GMTSQIT)
Q
YESCHK() ;DO NOT INCLUDE IF A 'YES' ASSESSMENT
I $P(PSOQREAC,U,2)'="YES" Q 0
I $P(PSOQREAC,U,2)="YES" I $P(PSOQREAC,U,3)["99VA8" Q 1
Q 1 ;STOP IF THERE IS ANY PROBLEMATIC DATA
;----------------------------------------------------------
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOQRART 2266 printed Nov 22, 2024@17:43:20 Page 2
PSOQRART ;HINES/RMS- TIU OBJECT FOR REMOTE ALLERGIES VIA RDI ; 30 Nov 2007 7:56 AM
+1 ;;7.0;OUTPATIENT PHARMACY;**294,411**;DEC 1997;Build 95
+2 ;
+3 ;Reference to CKP^GMTSUP supported by DBIA 4231
+4 ;References to ^ORRDI1 supported by DBIA 4659
+5 ;References to ^XTMP("ORRDI" supported by DBIA 4660
ENHS ;ENTRY POINT FOR HEALTH SUMMARY OF REMOTE ALLERGY/ADR DATA
+1 NEW PSOQHDR,PSOQRET,PSOQART,PSOQRART,PSOQFAC,PSOQREAC,PSOQRDI,PSOQDOWN
+2 if '$GET(DFN)
QUIT
+3 SET PSOQHDR=$$HAVEHDR^ORRDI1
IF '+$GET(PSOQHDR)
Begin DoDot:1
+4 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+5 WRITE !,"Remote Data from HDR not available"
+6 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
End DoDot:1
QUIT
+7 Begin DoDot:1
+8 IF $DATA(^XTMP("ORRDI","OUTAGE INFO","DOWN"))
HANG $$GET^XPAR("ALL","ORRDI PING FREQ")/2
+9 IF $DATA(^XTMP("ORRDI","OUTAGE INFO","DOWN"))
SET PSOQDOWN=1
Begin DoDot:2
+10 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+11 WRITE !,"WARNING: Connection to Remote Data Currently Down",!
+12 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
End DoDot:2
End DoDot:1
if $GET(PSOQDOWN)
QUIT
+13 ;RDI/HDR CALL ENCAPSULATION
Begin DoDot:1
+14 DO SAVDEV^%ZISUTL("PSOQHFS")
+15 SET PSOQRET=$$GET^ORRDI1(DFN,"ART")
+16 DO USE^%ZISUTL("PSOQHFS")
+17 DO RMDEV^%ZISUTL("PSOQHFS")
End DoDot:1
+18 IF PSOQRET=-1
Begin DoDot:1
+19 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+20 WRITE !,"Connection to Remote Data Not Available"
+21 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
End DoDot:1
QUIT
+22 IF '$DATA(^XTMP("ORRDI","ART",DFN))!('+PSOQRET)
Begin DoDot:1
+23 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+24 WRITE !,"No Remote Allergy/ADR Data available for this patient"
+25 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
End DoDot:1
QUIT
+26 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+27 WRITE !,"FACILITY",?40,"ALLERGY/ADR",!,"--------",?40,"-----------"
+28 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+29 FOR PSOQART=1:1:PSOQRET
Begin DoDot:1
+30 SET PSOQFAC=$GET(^XTMP("ORRDI","ART",DFN,PSOQART,"FACILITY",0))
+31 SET PSOQREAC=$GET(^XTMP("ORRDI","ART",DFN,PSOQART,"GMRALLERGY",0))
+32 if $$YESCHK
QUIT
+33 if PSOQFAC']""!(PSOQREAC']"")
QUIT
+34 SET PSOQREAC=$PIECE(PSOQREAC,U,2)
+35 SET PSOQRART(PSOQFAC,PSOQREAC)=""
End DoDot:1
+36 ;
SET PSOQFAC=""
FOR
SET PSOQFAC=$ORDER(PSOQRART(PSOQFAC))
if PSOQFAC']""
QUIT
Begin DoDot:1
+37 ;
SET PSOQREAC=""
FOR
SET PSOQREAC=$ORDER(PSOQRART(PSOQFAC,PSOQREAC))
if PSOQREAC']""
QUIT
Begin DoDot:2
+38 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+39 WRITE !,PSOQFAC,?40,PSOQREAC
+40 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
End DoDot:2
End DoDot:1
+41 QUIT
YESCHK() ;DO NOT INCLUDE IF A 'YES' ASSESSMENT
+1 IF $PIECE(PSOQREAC,U,2)'="YES"
QUIT 0
+2 IF $PIECE(PSOQREAC,U,2)="YES"
IF $PIECE(PSOQREAC,U,3)["99VA8"
QUIT 1
+3 ;STOP IF THERE IS ANY PROBLEMATIC DATA
QUIT 1
+4 ;----------------------------------------------------------
