- PSOQRART ;HINES/RMS- TIU OBJECT FOR REMOTE ALLERGIES VIA RDI ; 30 Nov 2007 7:56 AM
- ;;7.0;OUTPATIENT PHARMACY;**294**;DEC 1997;Build 13
- ;
- ;Reference to CKP^GMTSUP supported by DBIA 4231
- ;References to ORRDI1 supported by DBIA 4659
- 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,"REACTANT",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
- ;----------------------------------------------------------
- PSOQRART ;HINES/RMS- TIU OBJECT FOR REMOTE ALLERGIES VIA RDI ; 30 Nov 2007 7:56 AM
- +1 ;;7.0;OUTPATIENT PHARMACY;**294**;DEC 1997;Build 13
- +2 ;
- +3 ;Reference to CKP^GMTSUP supported by DBIA 4231
- +4 ;References to ORRDI1 supported by DBIA 4659
- 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,"REACTANT",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 ;----------------------------------------------------------
