BTIULO9.m

BTIULO9 ;IHS/CIA/MGH - IHS OBJECTS ADDED IN PATCHES FOR BEHAVIORAL HEALTH;09-Feb-2006 15:15;MGH

 ;;1.0;TEXT INTEGRATION UTILITIES;**1003,1004**;NOV 04, 2004

 ;Patch 1004 added location of home

 ;

WORKPH(DFN) ; EP;--

 ;Get work phone number

 NEW WORK

 Q:'$G(DFN)

 S WORK=$$GET1^DIQ(2,DFN,.132) S:WORK]"" WORK="Work phone: "_WORK

 I WORK="" S WORK="No Phone in record"

 Q WORK

OTHERPH(DFN) ;EP;--

 ;Get entry in the OTHER PHONE field

 NEW OTHER

 Q:'$G(DFN)

 S OTHER=$$GET1^DIQ(9000001,DFN,1801) S:OTHER]"" OTHER="Other phone: "_OTHER

 I OTHER="" S OTHER="No other phone in record"

 Q OTHER

EMPLOYER(DFN) ; EP

 ;Enter the employer name

 N EMP

 Q:'$G(DFN)

 S EMP=$$GET1^DIQ(9000001,DFN,.19) S:EMP]"" EMP="Employer: "_EMP

 I EMP="" S EMP="No employer listed"

 Q EMP

EMPSTAT(DFN) ; EP

 ;Enter the employment status

 N EMPST

 Q:'$G(DFN)

 S EMPST=$$GET1^DIQ(9000001,DFN,.21) S:EMPST]"" EMPST="Employment Status: "_EMPST

 I EMPST="" S EMPST="No employment status listed"

 Q EMPST

LOFHOME(DFN,TARGET) ;EP

 ;Find the location of home from the IHS patient file

 N LOC,CNT,LINE

 S CNT=0

 S LOC=0 F  S LOC=$O(^AUPNPAT(DFN,12,LOC)) Q:LOC=""  D

 .S CNT=$G(CNT)+1

 .I CNT=1 S @TARGET@(1,0)="Location of home: " S CNT=2

 .S LINE=$G(^AUPNPAT(DFN,12,LOC,0))

 .S @TARGET@(CNT,0)=$$SP(5)_LINE

 I '$G(CNT) S @TARGET@(1,0)="No location of home defined"

 Q "~@"_$NA(@TARGET)

 ;

PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data

 Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)

 ;

SP(NUM) ; -- SUBRTN to pad spaces

 Q $$PAD(" ",NUM)

BTIULO9   ;IHS/CIA/MGH - IHS OBJECTS ADDED IN PATCHES FOR BEHAVIORAL HEALTH;09-Feb-2006 15:15;MGH

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;**1003,1004**;NOV 04, 2004

 +2       ;Patch 1004 added location of home

 +3       ;

WORKPH(DFN) ; EP;--

 +1       ;Get work phone number

 +2        NEW WORK

 +3        IF '$GET(DFN)

               QUIT 

 +4        SET WORK=$$GET1^DIQ(2,DFN,.132)

           IF WORK]""

               SET WORK="Work phone: "_WORK

 +5        IF WORK=""

               SET WORK="No Phone in record"

 +6        QUIT WORK

OTHERPH(DFN) ;EP;--

 +1       ;Get entry in the OTHER PHONE field

 +2        NEW OTHER

 +3        IF '$GET(DFN)

               QUIT 

 +4        SET OTHER=$$GET1^DIQ(9000001,DFN,1801)

           IF OTHER]""

               SET OTHER="Other phone: "_OTHER

 +5        IF OTHER=""

               SET OTHER="No other phone in record"

 +6        QUIT OTHER

EMPLOYER(DFN) ; EP

 +1       ;Enter the employer name

 +2        NEW EMP

 +3        IF '$GET(DFN)

               QUIT 

 +4        SET EMP=$$GET1^DIQ(9000001,DFN,.19)

           IF EMP]""

               SET EMP="Employer: "_EMP

 +5        IF EMP=""

               SET EMP="No employer listed"

 +6        QUIT EMP

EMPSTAT(DFN) ; EP

 +1       ;Enter the employment status

 +2        NEW EMPST

 +3        IF '$GET(DFN)

               QUIT 

 +4        SET EMPST=$$GET1^DIQ(9000001,DFN,.21)

           IF EMPST]""

               SET EMPST="Employment Status: "_EMPST

 +5        IF EMPST=""

               SET EMPST="No employment status listed"

 +6        QUIT EMPST

LOFHOME(DFN,TARGET) ;EP

 +1       ;Find the location of home from the IHS patient file

 +2        NEW LOC,CNT,LINE

 +3        SET CNT=0

 +4        SET LOC=0

           FOR 

               SET LOC=$ORDER(^AUPNPAT(DFN,12,LOC))

               IF LOC=""

                   QUIT 

               Begin DoDot:1

 +5                SET CNT=$GET(CNT)+1

 +6                IF CNT=1

                       SET @TARGET@(1,0)="Location of home: "

                       SET CNT=2

 +7                SET LINE=$GET(^AUPNPAT(DFN,12,LOC,0))

 +8                SET @TARGET@(CNT,0)=$$SP(5)_LINE

               End DoDot:1

 +9        IF '$GET(CNT)

               SET @TARGET@(1,0)="No location of home defined"

 +10       QUIT "~@"_$NAME(@TARGET)

 +11      ;

PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data

 +1        QUIT $EXTRACT(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)

 +2       ;

SP(NUM)   ; -- SUBRTN to pad spaces

 +1        QUIT $$PAD(" ",NUM)