IBATLM3A ;LL/ELZ - TRANSFER PRICING PT INFO SCREEN BUILD ; 16-APR-1999
;;2.0;INTEGRATED BILLING;**115,516**;21-MAR-94;Build 123
;;Per VA Directive 6402, this routine should not be modified.
;
N IBX,IBY,IBINPT,IBINS,IBCNT K ^TMP("IBATPT",$J)
;
S IBCNT=0
S VAIP("D")="LAST" D A5^VADPT ; dbia 10061
S IBINPT=$G(^DPT(DFN,.105)) ; dbia 10035
S IBINS=$$INSURED^IBCNS1(DFN)
;
S IBY=""
D SET("*** Demographic Information ***",.IBY,24,31)
D SETVALM(.VALMCNT,.IBY)
D CNTRL^VALM10(VALMCNT,24,31,IOINHI,IOINORM)
D SETVALM(.VALMCNT,"")
;
D SET("Sex:",.IBY,21,4)
D SET($P(VADM(5),"^",2),.IBY,26,15)
D SET("Date of Birth:",.IBY,52,14)
D SET($P(VADM(3),"^",2),.IBY,67,13)
D SETVALM(.VALMCNT,.IBY)
;
D SET("Primary Care Provider:",.IBY,3,22)
D SET($P($$OUTPTPR^SDUTL3(DFN),"^",2),.IBY,26,15) ; dbia 1252
D SET("Date of Death:",.IBY,52,14)
D SET($$DATE(+VADM(6)),.IBY,67,13)
D SETVALM(.VALMCNT,.IBY)
D SETVALM(.VALMCNT,"")
;
D SET("Address:",.IBY,17,8)
F IBX=1:1:3 D:VAPA(IBX)'=""
. D SET(VAPA(IBX),.IBY,26,30)
. D SETVALM(.VALMCNT,.IBY)
D:IBY'="" SETVALM(.VALMCNT,.IBY)
;
D SET(VAPA(4)_", "_$P(VAPA(5),"^",2)_" "_VAPA(6),.IBY,26,30)
D SETVALM(.VALMCNT,.IBY)
D SETVALM(.VALMCNT,"")
D SETVALM(.VALMCNT,"")
;
D SET("*** Eligibility Information ***",.IBY,24,31)
D SETVALM(.VALMCNT,.IBY)
D CNTRL^VALM10(VALMCNT,24,31,IOINHI,IOINORM)
D SETVALM(.VALMCNT,"")
;
D SET("Patient Type:",.IBY,12,13)
D SET($P(VAEL(6),"^",2),.IBY,26,15)
D SET("Means Test Status:",.IBY,48,18)
D SET($P(VAEL(9),"^",2),.IBY,67,13)
D SETVALM(.VALMCNT,.IBY)
;
D SET("Primary Eligibility:",.IBY,5,20)
D SET($P(VAEL(1),"^",2),.IBY,26,15)
D SET("Enrollment Priority:",.IBY,46,31)
D SET($$PRIORITY^DGENA(DFN),.IBY,67,3) ; dbia #2918
D SETVALM(.VALMCNT,.IBY)
D SETVALM(.VALMCNT,"")
;
D SET("Secondary Eligibilities:",.IBY,1,24)
S IBX=0 F S IBX=$O(VAEL(1,IBX)) Q:IBX<1 D
. D SET($P(VAEL(1,IBX),"^",2),.IBY,26,30)
. D SETVALM(.VALMCNT,.IBY)
D:IBY'="" SETVALM(.VALMCNT,.IBY)
D SETVALM(.VALMCNT,"")
;
D SETVALM(.VALMCNT,"")
D SET("*** Insurance Information ***",.IBY,25,29)
D SETVALM(.VALMCNT,.IBY)
D CNTRL^VALM10(VALMCNT,25,29,IOINHI,IOINORM)
D SETVALM(.VALMCNT,"")
;
I IBINS D ALL^IBCNS1(DFN,"^TMP(""IBINS"",$J)",1) D K ^TMP("IBINS",$J)
. S IBX=0 F S IBX=$O(^TMP("IBINS",$J,IBX)) Q:IBX<1 S IBX(0)=^(IBX,0) D
.. D SET($P(^DIC(36,+IBX(0),0),"^"),.IBY,5,30)
.. D SET($P(IBX(0),"^",2),.IBY,35,15)
.. ;IB*2.0*516/TAZ - Use HIPAA compliant fields
.. ; HIPAA compliant Group Number is returned in piece 3 of ^TMP("IBINS",$J,IBX,0).
.. ;I $P(IBX(0),"^",18),$D(^IBA(355.3,$P(IBX(0),"^",18),0)) D SET($P(^IBA(355.3,$P(IBX(0),"^",18),0),"^",3),.IBY,60,20)
.. D SET($P(IBX(0),U,3),.IBY,60,20)
.. ; end changes for 516
.. D SETVALM(.VALMCNT,.IBY)
E D SET("Patient has no active insurance information",.IBY,5,75),SETVALM(.VALMCNT,.IBY)
D SETVALM(.VALMCNT,"")
;
D SETVALM(.VALMCNT,"")
D SET("*** Inpatient Information ***",.IBY,26,29)
D SETVALM(.VALMCNT,.IBY)
D CNTRL^VALM10(VALMCNT,26,29,IOINHI,IOINORM)
D SETVALM(.VALMCNT,"")
;
D SET("Inpatient Status:",.IBY,8,17)
D SET($S(IBINPT:"Active",1:"Inactive"),.IBY,26,10)
D SETVALM(.VALMCNT,.IBY)
;
D SET("Last Admission:",.IBY,10,17)
D SET($S(VAIP(1)="":"Never Admitted",1:$P(VAIP(13,1),"^",2)),.IBY,26,17)
D SET("Ward Location:",.IBY,47,14)
D SET($P(VAIP(13,4),"^",2),.IBY,62,18)
D SETVALM(.VALMCNT,.IBY)
D SETVALM(.VALMCNT,"")
;
D APPTS
;
D KVAR^VADPT ; dbia 10061
;
Q
APPTS ; -- displays last 5 appointments
;
D SETVALM(.VALMCNT,"")
D SET("*** Last Outpatient Appointments ***",.IBY,22,36)
D SETVALM(.VALMCNT,.IBY)
D CNTRL^VALM10(VALMCNT,22,36,IOINHI,IOINORM)
D SETVALM(.VALMCNT,"")
;
N IBVAL,IBFILTER
S IBVAL("DFN")=DFN
S IBVAL("BDT")=0
S IBVAL("EDT")=$$NOW^XLFDT
; screen children and inpatient encounters
S IBFILTER="I '$P(Y0,""^"",6),$P(Y0,""^"",12)'=8"
;
D SCAN^IBSDU("PATIENT/DATE",.IBVAL,IBFILTER,"D APPTCB^IBATLM3A",0,,"BACKWARD")
;
Q
APPTCB ; call back for scan to set up global
;
D SET($$DATE($P(Y0,"^"),5),.IBY,5,17)
D SET($P(^SC($P(Y0,"^",4),0),"^"),.IBY,25,30) ; dbia 10040
D SET($$EX^IBATUTL(409.68,.12,$P(Y0,"^",12)),.IBY,60,20)
D SETVALM(.VALMCNT,.IBY)
;
S IBCNT=IBCNT+1
S:IBCNT>4 SDSTOP=1
Q
;
SET(TEXT,STRING,COL,LENGTH) ; -- set up string with valm1
S STRING=$$SETSTR^VALM1($$LOWER^VALM1(TEXT),STRING,COL,LENGTH)
Q
SETVALM(LINE,TEXT) ; -- sets line for display
S LINE=LINE+1
S ^TMP("IBATPT",$J,LINE,0)=TEXT
S TEXT=""
Q
DATE(X,Y) ; -- returns date for display
S:'$D(Y) Y="5D"
Q $S(X:$$FMTE^XLFDT(X,Y),1:"")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBATLM3A 4696 printed Dec 13, 2024@02:07:57 Page 2
IBATLM3A ;LL/ELZ - TRANSFER PRICING PT INFO SCREEN BUILD ; 16-APR-1999
+1 ;;2.0;INTEGRATED BILLING;**115,516**;21-MAR-94;Build 123
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 NEW IBX,IBY,IBINPT,IBINS,IBCNT
KILL ^TMP("IBATPT",$JOB)
+5 ;
+6 SET IBCNT=0
+7 ; dbia 10061
SET VAIP("D")="LAST"
DO A5^VADPT
+8 ; dbia 10035
SET IBINPT=$GET(^DPT(DFN,.105))
+9 SET IBINS=$$INSURED^IBCNS1(DFN)
+10 ;
+11 SET IBY=""
+12 DO SET("*** Demographic Information ***",.IBY,24,31)
+13 DO SETVALM(.VALMCNT,.IBY)
+14 DO CNTRL^VALM10(VALMCNT,24,31,IOINHI,IOINORM)
+15 DO SETVALM(.VALMCNT,"")
+16 ;
+17 DO SET("Sex:",.IBY,21,4)
+18 DO SET($PIECE(VADM(5),"^",2),.IBY,26,15)
+19 DO SET("Date of Birth:",.IBY,52,14)
+20 DO SET($PIECE(VADM(3),"^",2),.IBY,67,13)
+21 DO SETVALM(.VALMCNT,.IBY)
+22 ;
+23 DO SET("Primary Care Provider:",.IBY,3,22)
+24 ; dbia 1252
DO SET($PIECE($$OUTPTPR^SDUTL3(DFN),"^",2),.IBY,26,15)
+25 DO SET("Date of Death:",.IBY,52,14)
+26 DO SET($$DATE(+VADM(6)),.IBY,67,13)
+27 DO SETVALM(.VALMCNT,.IBY)
+28 DO SETVALM(.VALMCNT,"")
+29 ;
+30 DO SET("Address:",.IBY,17,8)
+31 FOR IBX=1:1:3
if VAPA(IBX)'=""
Begin DoDot:1
+32 DO SET(VAPA(IBX),.IBY,26,30)
+33 DO SETVALM(.VALMCNT,.IBY)
End DoDot:1
+34 if IBY'=""
DO SETVALM(.VALMCNT,.IBY)
+35 ;
+36 DO SET(VAPA(4)_", "_$PIECE(VAPA(5),"^",2)_" "_VAPA(6),.IBY,26,30)
+37 DO SETVALM(.VALMCNT,.IBY)
+38 DO SETVALM(.VALMCNT,"")
+39 DO SETVALM(.VALMCNT,"")
+40 ;
+41 DO SET("*** Eligibility Information ***",.IBY,24,31)
+42 DO SETVALM(.VALMCNT,.IBY)
+43 DO CNTRL^VALM10(VALMCNT,24,31,IOINHI,IOINORM)
+44 DO SETVALM(.VALMCNT,"")
+45 ;
+46 DO SET("Patient Type:",.IBY,12,13)
+47 DO SET($PIECE(VAEL(6),"^",2),.IBY,26,15)
+48 DO SET("Means Test Status:",.IBY,48,18)
+49 DO SET($PIECE(VAEL(9),"^",2),.IBY,67,13)
+50 DO SETVALM(.VALMCNT,.IBY)
+51 ;
+52 DO SET("Primary Eligibility:",.IBY,5,20)
+53 DO SET($PIECE(VAEL(1),"^",2),.IBY,26,15)
+54 DO SET("Enrollment Priority:",.IBY,46,31)
+55 ; dbia #2918
DO SET($$PRIORITY^DGENA(DFN),.IBY,67,3)
+56 DO SETVALM(.VALMCNT,.IBY)
+57 DO SETVALM(.VALMCNT,"")
+58 ;
+59 DO SET("Secondary Eligibilities:",.IBY,1,24)
+60 SET IBX=0
FOR
SET IBX=$ORDER(VAEL(1,IBX))
if IBX<1
QUIT
Begin DoDot:1
+61 DO SET($PIECE(VAEL(1,IBX),"^",2),.IBY,26,30)
+62 DO SETVALM(.VALMCNT,.IBY)
End DoDot:1
+63 if IBY'=""
DO SETVALM(.VALMCNT,.IBY)
+64 DO SETVALM(.VALMCNT,"")
+65 ;
+66 DO SETVALM(.VALMCNT,"")
+67 DO SET("*** Insurance Information ***",.IBY,25,29)
+68 DO SETVALM(.VALMCNT,.IBY)
+69 DO CNTRL^VALM10(VALMCNT,25,29,IOINHI,IOINORM)
+70 DO SETVALM(.VALMCNT,"")
+71 ;
+72 IF IBINS
DO ALL^IBCNS1(DFN,"^TMP(""IBINS"",$J)",1)
Begin DoDot:1
+73 SET IBX=0
FOR
SET IBX=$ORDER(^TMP("IBINS",$JOB,IBX))
if IBX<1
QUIT
SET IBX(0)=^(IBX,0)
Begin DoDot:2
+74 DO SET($PIECE(^DIC(36,+IBX(0),0),"^"),.IBY,5,30)
+75 DO SET($PIECE(IBX(0),"^",2),.IBY,35,15)
+76 ;IB*2.0*516/TAZ - Use HIPAA compliant fields
+77 ; HIPAA compliant Group Number is returned in piece 3 of ^TMP("IBINS",$J,IBX,0).
+78 ;I $P(IBX(0),"^",18),$D(^IBA(355.3,$P(IBX(0),"^",18),0)) D SET($P(^IBA(355.3,$P(IBX(0),"^",18),0),"^",3),.IBY,60,20)
+79 DO SET($PIECE(IBX(0),U,3),.IBY,60,20)
+80 ; end changes for 516
+81 DO SETVALM(.VALMCNT,.IBY)
End DoDot:2
End DoDot:1
KILL ^TMP("IBINS",$JOB)
+82 IF '$TEST
DO SET("Patient has no active insurance information",.IBY,5,75)
DO SETVALM(.VALMCNT,.IBY)
+83 DO SETVALM(.VALMCNT,"")
+84 ;
+85 DO SETVALM(.VALMCNT,"")
+86 DO SET("*** Inpatient Information ***",.IBY,26,29)
+87 DO SETVALM(.VALMCNT,.IBY)
+88 DO CNTRL^VALM10(VALMCNT,26,29,IOINHI,IOINORM)
+89 DO SETVALM(.VALMCNT,"")
+90 ;
+91 DO SET("Inpatient Status:",.IBY,8,17)
+92 DO SET($SELECT(IBINPT:"Active",1:"Inactive"),.IBY,26,10)
+93 DO SETVALM(.VALMCNT,.IBY)
+94 ;
+95 DO SET("Last Admission:",.IBY,10,17)
+96 DO SET($SELECT(VAIP(1)="":"Never Admitted",1:$PIECE(VAIP(13,1),"^",2)),.IBY,26,17)
+97 DO SET("Ward Location:",.IBY,47,14)
+98 DO SET($PIECE(VAIP(13,4),"^",2),.IBY,62,18)
+99 DO SETVALM(.VALMCNT,.IBY)
+100 DO SETVALM(.VALMCNT,"")
+101 ;
+102 DO APPTS
+103 ;
+104 ; dbia 10061
DO KVAR^VADPT
+105 ;
+106 QUIT
APPTS ; -- displays last 5 appointments
+1 ;
+2 DO SETVALM(.VALMCNT,"")
+3 DO SET("*** Last Outpatient Appointments ***",.IBY,22,36)
+4 DO SETVALM(.VALMCNT,.IBY)
+5 DO CNTRL^VALM10(VALMCNT,22,36,IOINHI,IOINORM)
+6 DO SETVALM(.VALMCNT,"")
+7 ;
+8 NEW IBVAL,IBFILTER
+9 SET IBVAL("DFN")=DFN
+10 SET IBVAL("BDT")=0
+11 SET IBVAL("EDT")=$$NOW^XLFDT
+12 ; screen children and inpatient encounters
+13 SET IBFILTER="I '$P(Y0,""^"",6),$P(Y0,""^"",12)'=8"
+14 ;
+15 DO SCAN^IBSDU("PATIENT/DATE",.IBVAL,IBFILTER,"D APPTCB^IBATLM3A",0,,"BACKWARD")
+16 ;
+17 QUIT
APPTCB ; call back for scan to set up global
+1 ;
+2 DO SET($$DATE($PIECE(Y0,"^"),5),.IBY,5,17)
+3 ; dbia 10040
DO SET($PIECE(^SC($PIECE(Y0,"^",4),0),"^"),.IBY,25,30)
+4 DO SET($$EX^IBATUTL(409.68,.12,$PIECE(Y0,"^",12)),.IBY,60,20)
+5 DO SETVALM(.VALMCNT,.IBY)
+6 ;
+7 SET IBCNT=IBCNT+1
+8 if IBCNT>4
SET SDSTOP=1
+9 QUIT
+10 ;
SET(TEXT,STRING,COL,LENGTH) ; -- set up string with valm1
+1 SET STRING=$$SETSTR^VALM1($$LOWER^VALM1(TEXT),STRING,COL,LENGTH)
+2 QUIT
SETVALM(LINE,TEXT) ; -- sets line for display
+1 SET LINE=LINE+1
+2 SET ^TMP("IBATPT",$JOB,LINE,0)=TEXT
+3 SET TEXT=""
+4 QUIT
DATE(X,Y) ; -- returns date for display
+1 if '$DATA(Y)
SET Y="5D"
+2 QUIT $SELECT(X:$$FMTE^XLFDT(X,Y),1:"")
