- 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 Jan 18, 2025@03:18:13 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