- IBDFN6 ;ALB/CJM - ENCOUNTER FORM - INTERFACE ROUTINES ;NOV 16,1992
- ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
- ADDRESS ;returns address, telephone
- ;input variables - DFN
- N ARY,CNT,LINE S CNT=1
- S ARY="^TMP(""IB"",$J,""INTERFACES"",+$G(DFN))"
- D ADD^VADPT
- I VAERR S (@ARY@("DPT PATIENT ADDRESS LINES"),@ARY@("DPT PATIENT'S TELEPHONE NUMBER"),@ARY@("DPT PATIENT SHORT ADDRESS"))="" Q
- I VAPA(1)'="" S @ARY@("DPT PATIENT ADDRESS LINES",CNT)=VAPA(1),CNT=CNT+1
- I VAPA(2)'="" S @ARY@("DPT PATIENT ADDRESS LINES",CNT)=VAPA(2),CNT=CNT+1
- I VAPA(3)'="" S @ARY@("DPT PATIENT ADDRESS LINES",CNT)=VAPA(3),CNT=CNT+1
- S @ARY@("DPT PATIENT ADDRESS LINES",CNT)=VAPA(4)_", "_$P(VAPA(5),"^",2)_" "_$P(VAPA(11),"^",2)
- ;
- ;short address
- F CNT=1:1:3 S LINE=VAPA(CNT) Q:LINE'=""
- S @ARY@("DPT PATIENT SHORT ADDRESS")=LINE_","_VAPA(4)_", "_$P(VAPA(5),"^",2)_" "_$P(VAPA(11),"^",2)
- ;
- S @ARY@("DPT PATIENT'S TELEPHONE NUMBER")=VAPA(8)
- K VAPA,VA,VAERR,VAEL
- Q
- ;
- INSURANC ;returns all sorts of insurance information
- ;input - DFN,ACT
- ;ACT="" to return all insurance, ACT=1 to return only active insurance, ACT=2 to return active insurance and insurance that will not reimburse (Medicare)
- ;
- Q:'$G(DFN)
- N NODE,SUB,ITEM,ENTRY,DATE,ARY,WHO
- I $L($T(ALL^IBCNS1)) D
- .S ARY="^TMP(""IBDF"",$J,""INSURANCE"")"
- .K @ARY
- .D ALL^IBCNS1(DFN,ARY,$G(ACT))
- ;
- S SUB=0,ITEM=1,ENTRY="" F S SUB=$O(@ARY@(SUB)) Q:'SUB D
- .S NODE=$G(@ARY@(SUB,0)) Q:NODE=""
- .S:$P(NODE,"^") ENTRY=$P($G(^DIC(36,$P(NODE,"^"),0)),"^")
- .S Y=$P(NODE,"^",4) I Y>0 D DD^%DT S $P(ENTRY,"^",2)=Y
- .S $P(ENTRY,"^",3)=$P(NODE,"^",2)
- .S $P(ENTRY,"^",4)=$P(NODE,"^",3)
- .S $P(ENTRY,"^",5)=$P(NODE,"^",15)
- .S $P(ENTRY,"^",6)=$P(NODE,"^",17)
- .S WHO=$P(NODE,"^",6)
- .S $P(ENTRY,"^",7)=$S(WHO="v":"APPLICANT",WHO="s":"SPOUSE",WHO="o":"OTHER",1:"")
- .S @IBARY@(ITEM)=ENTRY
- .S ITEM=ITEM+1
- K @ARY
- Q
- ;
- INSURED ;is the patient insured?
- ;input - DFN
- Q:'$G(DFN)
- N INS S INS=""
- ;do it the new way?
- I $L($T(INSURED^IBCNS1)) D
- .S INS=$$INSURED^IBCNS1(DFN)
- S @IBARY=$S(INS=1:"YES",INS=0:"NO",1:"UNKNOWN")
- Q
- IBDFN6 ;ALB/CJM - ENCOUNTER FORM - INTERFACE ROUTINES ;NOV 16,1992
- +1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
- ADDRESS ;returns address, telephone
- +1 ;input variables - DFN
- +2 NEW ARY,CNT,LINE
- SET CNT=1
- +3 SET ARY="^TMP(""IB"",$J,""INTERFACES"",+$G(DFN))"
- +4 DO ADD^VADPT
- +5 IF VAERR
- SET (@ARY@("DPT PATIENT ADDRESS LINES"),@ARY@("DPT PATIENT'S TELEPHONE NUMBER"),@ARY@("DPT PATIENT SHORT ADDRESS"))=""
- QUIT
- +6 IF VAPA(1)'=""
- SET @ARY@("DPT PATIENT ADDRESS LINES",CNT)=VAPA(1)
- SET CNT=CNT+1
- +7 IF VAPA(2)'=""
- SET @ARY@("DPT PATIENT ADDRESS LINES",CNT)=VAPA(2)
- SET CNT=CNT+1
- +8 IF VAPA(3)'=""
- SET @ARY@("DPT PATIENT ADDRESS LINES",CNT)=VAPA(3)
- SET CNT=CNT+1
- +9 SET @ARY@("DPT PATIENT ADDRESS LINES",CNT)=VAPA(4)_", "_$PIECE(VAPA(5),"^",2)_" "_$PIECE(VAPA(11),"^",2)
- +10 ;
- +11 ;short address
- +12 FOR CNT=1:1:3
- SET LINE=VAPA(CNT)
- IF LINE'=""
- QUIT
- +13 SET @ARY@("DPT PATIENT SHORT ADDRESS")=LINE_","_VAPA(4)_", "_$PIECE(VAPA(5),"^",2)_" "_$PIECE(VAPA(11),"^",2)
- +14 ;
- +15 SET @ARY@("DPT PATIENT'S TELEPHONE NUMBER")=VAPA(8)
- +16 KILL VAPA,VA,VAERR,VAEL
- +17 QUIT
- +18 ;
- INSURANC ;returns all sorts of insurance information
- +1 ;input - DFN,ACT
- +2 ;ACT="" to return all insurance, ACT=1 to return only active insurance, ACT=2 to return active insurance and insurance that will not reimburse (Medicare)
- +3 ;
- +4 IF '$GET(DFN)
- QUIT
- +5 NEW NODE,SUB,ITEM,ENTRY,DATE,ARY,WHO
- +6 IF $LENGTH($TEXT(ALL^IBCNS1))
- Begin DoDot:1
- +7 SET ARY="^TMP(""IBDF"",$J,""INSURANCE"")"
- +8 KILL @ARY
- +9 DO ALL^IBCNS1(DFN,ARY,$GET(ACT))
- End DoDot:1
- +10 ;
- +11 SET SUB=0
- SET ITEM=1
- SET ENTRY=""
- FOR
- SET SUB=$ORDER(@ARY@(SUB))
- IF 'SUB
- QUIT
- Begin DoDot:1
- +12 SET NODE=$GET(@ARY@(SUB,0))
- IF NODE=""
- QUIT
- +13 IF $PIECE(NODE,"^")
- SET ENTRY=$PIECE($GET(^DIC(36,$PIECE(NODE,"^"),0)),"^")
- +14 SET Y=$PIECE(NODE,"^",4)
- IF Y>0
- DO DD^%DT
- SET $PIECE(ENTRY,"^",2)=Y
- +15 SET $PIECE(ENTRY,"^",3)=$PIECE(NODE,"^",2)
- +16 SET $PIECE(ENTRY,"^",4)=$PIECE(NODE,"^",3)
- +17 SET $PIECE(ENTRY,"^",5)=$PIECE(NODE,"^",15)
- +18 SET $PIECE(ENTRY,"^",6)=$PIECE(NODE,"^",17)
- +19 SET WHO=$PIECE(NODE,"^",6)
- +20 SET $PIECE(ENTRY,"^",7)=$SELECT(WHO="v":"APPLICANT",WHO="s":"SPOUSE",WHO="o":"OTHER",1:"")
- +21 SET @IBARY@(ITEM)=ENTRY
- +22 SET ITEM=ITEM+1
- End DoDot:1
- +23 KILL @ARY
- +24 QUIT
- +25 ;
- INSURED ;is the patient insured?
- +1 ;input - DFN
- +2 IF '$GET(DFN)
- QUIT
- +3 NEW INS
- SET INS=""
- +4 ;do it the new way?
- +5 IF $LENGTH($TEXT(INSURED^IBCNS1))
- Begin DoDot:1
- +6 SET INS=$$INSURED^IBCNS1(DFN)
- End DoDot:1
- +7 SET @IBARY=$SELECT(INS=1:"YES",INS=0:"NO",1:"UNKNOWN")
- +8 QUIT
