BHLUP.m

BHLUP ; cmi/anchorage/maw - BHL Update Specific Fields;

 ;;3.01;BHL IHS Interfaces with GIS;**11,13,14**;AUG 01, 2004

 ;

 ;

 ;

 ;this routine will always change based on the need of updating fields in GIS

 ;

FLDS ;EP - update various fields in this subroutine

 D DOB

 D EMPH

 ;D RAD

 Q

 ;

DOB ;-- change the DOB to reflect a new output transform

 N BHLDA

 S BHLDA=$O(^INTHL7F("B","HL IHS PID DOB (PID-7)",0))

 Q:'BHLDA

 S DIE="^INTHL7F(",DA=BHLDA

 S DR=".02///STRING;3///"_"""OUTPUT TRANSFORM"""

 D ^DIE

 K DIE,DR,DA

 S ^INTHL7F(BHLDA,5)="S X=$P($G(^DPT(INDA,0)),U,3),%DT=""X"" D ^%DT S X=$$DATE^INHUT(Y)"

 Q

 ;

EMPH ;-- change the employer phone

 N BHLDA

 S BHLDA=$O(^INTHL7F("B","HL IHS GT1 EMP PH (GT1-18)",0))

 Q:'BHLDA

 S ^INTHL7F(BHLDA,5)="S X="",BHLEMPHN=$$VALI^XBDIQ1(9000003.1,INDA,.16) I BHLEMPHN'="" S X=$$VAL^XBDIQ1(9999999.75,BHLEMPHN,.06)"

 Q

 ;

RAD ;-- disable new RAD transaction types if not being used

 N BHLPC,BHLDLS

 S BHLPC=$O(^INTHPC("B","HL IHS GE PACS TRANSMITTER",0))

 I 'BHLPC D RADDIS Q

 S BHLDLS=$P($P($G(^INTHPC(BHLPC,0)),U,5),".")

 I BHLDLS<3040101 D RADDIS Q

 Q

 ;

RADDIS ;-- disable the tt's

 N BHLTT

 S BHLTT=$O(^INRHT("B","HL IHS O01 GE OUT PARENT",0))

 I BHLTT D

 . S DIE="^INRHT(",DA=BHLTT,DR=".05///0" D ^DIE

 . K DIE,DR

 S BHLTT=$O(^INRHT("B","HL IHS R01 GE OUT PARENT",0))

 I BHLTT D

 . S DIE="^INRHT(",DA=BHLTT,DR=".05///0" D ^DIE

 . K DIE,DR

 Q

 ;

BHLUP     ; cmi/anchorage/maw - BHL Update Specific Fields;

 +1       ;;3.01;BHL IHS Interfaces with GIS;**11,13,14**;AUG 01, 2004

 +2       ;

 +3       ;

 +4       ;

 +5       ;this routine will always change based on the need of updating fields in GIS

 +6       ;

FLDS      ;EP - update various fields in this subroutine

 +1        DO DOB

 +2        DO EMPH

 +3       ;D RAD

 +4        QUIT 

 +5       ;

DOB       ;-- change the DOB to reflect a new output transform

 +1        NEW BHLDA

 +2        SET BHLDA=$ORDER(^INTHL7F("B","HL IHS PID DOB (PID-7)",0))

 +3        IF 'BHLDA

               QUIT 

 +4        SET DIE="^INTHL7F("

           SET DA=BHLDA

 +5        SET DR=".02///STRING;3///"_"""OUTPUT TRANSFORM"""

 +6        DO ^DIE

 +7        KILL DIE,DR,DA

 +8        SET ^INTHL7F(BHLDA,5)="S X=$P($G(^DPT(INDA,0)),U,3),%DT=""X"" D ^%DT S X=$$DATE^INHUT(Y)"

 +9        QUIT 

 +10      ;

EMPH      ;-- change the employer phone

 +1        NEW BHLDA

 +2        SET BHLDA=$ORDER(^INTHL7F("B","HL IHS GT1 EMP PH (GT1-18)",0))

 +3        IF 'BHLDA

               QUIT 

 +4        SET ^INTHL7F(BHLDA,5)="S X="",BHLEMPHN=$$VALI^XBDIQ1(9000003.1,INDA,.16) I BHLEMPHN'="" S X=$$VAL^XBDIQ1(9999999.75,BHLEMPHN,.06)"

 +5        QUIT 

 +6       ;

RAD       ;-- disable new RAD transaction types if not being used

 +1        NEW BHLPC,BHLDLS

 +2        SET BHLPC=$ORDER(^INTHPC("B","HL IHS GE PACS TRANSMITTER",0))

 +3        IF 'BHLPC

               DO RADDIS

               QUIT 

 +4        SET BHLDLS=$PIECE($PIECE($GET(^INTHPC(BHLPC,0)),U,5),".")

 +5        IF BHLDLS<3040101

               DO RADDIS

               QUIT 

 +6        QUIT 

 +7       ;

RADDIS    ;-- disable the tt's

 +1        NEW BHLTT

 +2        SET BHLTT=$ORDER(^INRHT("B","HL IHS O01 GE OUT PARENT",0))

 +3        IF BHLTT

               Begin DoDot:1

 +4                SET DIE="^INRHT("

                   SET DA=BHLTT

                   SET DR=".05///0"

                   DO ^DIE

 +5                KILL DIE,DR

               End DoDot:1

 +6        SET BHLTT=$ORDER(^INRHT("B","HL IHS R01 GE OUT PARENT",0))

 +7        IF BHLTT

               Begin DoDot:1

 +8                SET DIE="^INRHT("

                   SET DA=BHLTT

                   SET DR=".05///0"

                   DO ^DIE

 +9                KILL DIE,DR

               End DoDot:1

 +10       QUIT 

 +11      ;