IBCNSC41 ;ALB/TMP - INSURANCE PLAN SCREEN UTILITIES (CONT) ; 15-AUG-95
;;2.0;INTEGRATED BILLING;**43,416,763**;21-MAR-94;Build 29
;;Per VHA Directive 2004-038, this routine should not be modified.
;
HDR ; -- Plan detail screen header
S VALMHDR(1)="Plan Information for: "_$E($P($G(^DIC(36,+$G(IBCPOLD),0)),"^"),1,20)_" Insurance Company",VALMHDR(2)=$J("",40)_"** Plan Currently "_$S($P(IBCPOLD,U,11):"Ina",1:"A")_"ctive **"
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K VALMBCK,^TMP("IBCNSCP",$J),IBVPCLBG,IBVPCLEN
D CLEAN^VALM10,CLEAR^VALM1
Q
;
LIMBLD(START,OFFSET,IBLCNT) ; Build actual limit display
;
N COV,COVD,COVFN,IBCNT,LEDT,LIM,LINE,X1,Z0
S LINE=3
D SET^IBCNSC4(START,OFFSET," Plan Coverage Limitations ",IORVON,IORVOFF)
D SET^IBCNSC4(START+1,OFFSET," Coverage Effective Date Covered? Limit Comments")
D SET^IBCNSC4(START+2,OFFSET," -------- -------------- -------- --------------")
;
S LIM=0
F S LIM=$O(^IBE(355.31,LIM)) Q:'LIM D
. S COV=$P($G(^IBE(355.31,LIM,0)),U,1) ; coverage category name
. ;
. ; check if no entry on file for this coverage category
. I '$D(^IBA(355.32,"APCD",IBCPOL,LIM)) D Q
.. D SET^IBCNSC4(START+LINE,OFFSET," "_$E(COV_$J("",18),1,18)_$J("",19)_"BY DEFAULT")
.. S LINE=LINE+1
.. Q
. ;
. S IBCNT=0 ; count of the number of entries displayed for each coverage category
. S LEDT=""
. F S LEDT=$O(^IBA(355.32,"APCD",IBCPOL,LIM,LEDT)) Q:LEDT="" D
.. S COVFN=+$O(^IBA(355.32,"APCD",IBCPOL,LIM,+LEDT,""))
.. S COVD=$G(^IBA(355.32,+COVFN,0))
.. ;
.. S IBCNT=IBCNT+1
.. S X1=" "_$E($S(IBCNT=1:COV,1:"")_$J("",18),1,18) ; Don't dup category name display
.. S X1=X1_" "_$$FO^IBCNEUT1($$FMTE^XLFDT(-LEDT,"5Z"),10)_$J("",7)_$S($P(COVD,U,4):$S($P(COVD,U,4)<2:"YES"_$J("",8),$P(COVD,U,4)=2:"CONDITIONAL",1:"UNKNOWN "),1:"NO"_$J("",9))_$J("",5)
.. D SET^IBCNSC4(START+LINE,OFFSET,X1)
.. I '$O(^IBA(355.32,COVFN,2,0)) S LINE=LINE+1
.. S Z0=0 F S Z0=$O(^IBA(355.32,COVFN,2,Z0)) Q:'Z0 D SET^IBCNSC4(START+LINE,OFFSET+54,$G(^IBA(355.32,COVFN,2,Z0,0))) S LINE=LINE+1
.. Q
. Q
;
D LASTEDT ;IB*763/CKB
;
S IBLCNT=LINE-3
Q
;
LASTEDT ; Display last edited info, who and when ;IB*763/CKB
N COVFN,IBCDT,IBCBY,IENS,LASTUPD,LSTBY,LSTDT
;
; Set LASTUPD if the LAST xref doesn't exist
I '$D(^IBA(355.32,"LAST",IBCPOL)) D
. S LASTUPD=" COVERAGE Last Updated by "
;
; Set LASTUPD if the LAST xref DOES exist
I $D(^IBA(355.32,"LAST",IBCPOL)) D
. S IBCDT=$O(^IBA(355.32,"LAST",IBCPOL,"")),IBCBY=$O(^IBA(355.32,"LAST",IBCPOL,IBCDT,""))
. S COVFN=$O(^IBA(355.32,"LAST",IBCPOL,IBCDT,IBCBY,"")),IENS=COVFN_","
. S LSTDT=$$GET1^DIQ(355.32,IENS,1.03,"I"),LSTBY=$$GET1^DIQ(355.32,IENS,1.04,"E")
. S LASTUPD=" COVERAGE Last Updated "_$$FO^IBCNEUT1($$FMTE^XLFDT(LSTDT,"5Z"),10)_" by "_LSTBY
;
; Display the LASTUPD to the screen
D SET^IBCNSC4(START+LINE,OFFSET," ") S LINE=LINE+1 ;blank line
D SET^IBCNSC4(START+LINE,OFFSET,LASTUPD)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNSC41 3070 printed Dec 13, 2024@02:17 Page 2
IBCNSC41 ;ALB/TMP - INSURANCE PLAN SCREEN UTILITIES (CONT) ; 15-AUG-95
+1 ;;2.0;INTEGRATED BILLING;**43,416,763**;21-MAR-94;Build 29
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
HDR ; -- Plan detail screen header
+1 SET VALMHDR(1)="Plan Information for: "_$EXTRACT($PIECE($GET(^DIC(36,+$GET(IBCPOLD),0)),"^"),1,20)_" Insurance Company"
SET VALMHDR(2)=$JUSTIFY("",40)_"** Plan Currently "_$SELECT($PIECE(IBCPOLD,U,11):"Ina",1:"A")_"ctive **"
+2 QUIT
+3 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL VALMBCK,^TMP("IBCNSCP",$JOB),IBVPCLBG,IBVPCLEN
+2 DO CLEAN^VALM10
DO CLEAR^VALM1
+3 QUIT
+4 ;
LIMBLD(START,OFFSET,IBLCNT) ; Build actual limit display
+1 ;
+2 NEW COV,COVD,COVFN,IBCNT,LEDT,LIM,LINE,X1,Z0
+3 SET LINE=3
+4 DO SET^IBCNSC4(START,OFFSET," Plan Coverage Limitations ",IORVON,IORVOFF)
+5 DO SET^IBCNSC4(START+1,OFFSET," Coverage Effective Date Covered? Limit Comments")
+6 DO SET^IBCNSC4(START+2,OFFSET," -------- -------------- -------- --------------")
+7 ;
+8 SET LIM=0
+9 FOR
SET LIM=$ORDER(^IBE(355.31,LIM))
if 'LIM
QUIT
Begin DoDot:1
+10 ; coverage category name
SET COV=$PIECE($GET(^IBE(355.31,LIM,0)),U,1)
+11 ;
+12 ; check if no entry on file for this coverage category
+13 IF '$DATA(^IBA(355.32,"APCD",IBCPOL,LIM))
Begin DoDot:2
+14 DO SET^IBCNSC4(START+LINE,OFFSET," "_$EXTRACT(COV_$JUSTIFY("",18),1,18)_$JUSTIFY("",19)_"BY DEFAULT")
+15 SET LINE=LINE+1
+16 QUIT
End DoDot:2
QUIT
+17 ;
+18 ; count of the number of entries displayed for each coverage category
SET IBCNT=0
+19 SET LEDT=""
+20 FOR
SET LEDT=$ORDER(^IBA(355.32,"APCD",IBCPOL,LIM,LEDT))
if LEDT=""
QUIT
Begin DoDot:2
+21 SET COVFN=+$ORDER(^IBA(355.32,"APCD",IBCPOL,LIM,+LEDT,""))
+22 SET COVD=$GET(^IBA(355.32,+COVFN,0))
+23 ;
+24 SET IBCNT=IBCNT+1
+25 ; Don't dup category name display
SET X1=" "_$EXTRACT($SELECT(IBCNT=1:COV,1:"")_$JUSTIFY("",18),1,18)
+26 SET X1=X1_" "_$$FO^IBCNEUT1($$FMTE^XLFDT(-LEDT,"5Z"),10)_$JUSTIFY("",7)_$SELECT($PIECE(COVD,U,4):$SELECT($PIECE(COVD,U,4)<2:"YES"_$JUSTIFY("",8),$PIECE(COVD,U,4)=2:"CONDITIONAL",1:"UNKNOWN "),1:"NO"_$JUSTIFY("",9))_$JUSTIFY(
"",5)
+27 DO SET^IBCNSC4(START+LINE,OFFSET,X1)
+28 IF '$ORDER(^IBA(355.32,COVFN,2,0))
SET LINE=LINE+1
+29 SET Z0=0
FOR
SET Z0=$ORDER(^IBA(355.32,COVFN,2,Z0))
if 'Z0
QUIT
DO SET^IBCNSC4(START+LINE,OFFSET+54,$GET(^IBA(355.32,COVFN,2,Z0,0)))
SET LINE=LINE+1
+30 QUIT
End DoDot:2
+31 QUIT
End DoDot:1
+32 ;
+33 ;IB*763/CKB
DO LASTEDT
+34 ;
+35 SET IBLCNT=LINE-3
+36 QUIT
+37 ;
LASTEDT ; Display last edited info, who and when ;IB*763/CKB
+1 NEW COVFN,IBCDT,IBCBY,IENS,LASTUPD,LSTBY,LSTDT
+2 ;
+3 ; Set LASTUPD if the LAST xref doesn't exist
+4 IF '$DATA(^IBA(355.32,"LAST",IBCPOL))
Begin DoDot:1
+5 SET LASTUPD=" COVERAGE Last Updated by "
End DoDot:1
+6 ;
+7 ; Set LASTUPD if the LAST xref DOES exist
+8 IF $DATA(^IBA(355.32,"LAST",IBCPOL))
Begin DoDot:1
+9 SET IBCDT=$ORDER(^IBA(355.32,"LAST",IBCPOL,""))
SET IBCBY=$ORDER(^IBA(355.32,"LAST",IBCPOL,IBCDT,""))
+10 SET COVFN=$ORDER(^IBA(355.32,"LAST",IBCPOL,IBCDT,IBCBY,""))
SET IENS=COVFN_","
+11 SET LSTDT=$$GET1^DIQ(355.32,IENS,1.03,"I")
SET LSTBY=$$GET1^DIQ(355.32,IENS,1.04,"E")
+12 SET LASTUPD=" COVERAGE Last Updated "_$$FO^IBCNEUT1($$FMTE^XLFDT(LSTDT,"5Z"),10)_" by "_LSTBY
End DoDot:1
+13 ;
+14 ; Display the LASTUPD to the screen
+15 ;blank line
DO SET^IBCNSC4(START+LINE,OFFSET," ")
SET LINE=LINE+1
+16 DO SET^IBCNSC4(START+LINE,OFFSET,LASTUPD)
+17 QUIT
