Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNSC41

IBCNSC41.m

Go to the documentation of this file.
  1. IBCNSC41 ;ALB/TMP - INSURANCE PLAN SCREEN UTILITIES (CONT) ; 15-AUG-95
  1. ;;2.0;INTEGRATED BILLING;**43,416,763**;21-MAR-94;Build 29
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. HDR ; -- Plan detail screen header
  1. 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 **"
  1. Q
  1. ;
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. K VALMBCK,^TMP("IBCNSCP",$J),IBVPCLBG,IBVPCLEN
  1. D CLEAN^VALM10,CLEAR^VALM1
  1. Q
  1. ;
  1. LIMBLD(START,OFFSET,IBLCNT) ; Build actual limit display
  1. ;
  1. N COV,COVD,COVFN,IBCNT,LEDT,LIM,LINE,X1,Z0
  1. S LINE=3
  1. D SET^IBCNSC4(START,OFFSET," Plan Coverage Limitations ",IORVON,IORVOFF)
  1. D SET^IBCNSC4(START+1,OFFSET," Coverage Effective Date Covered? Limit Comments")
  1. D SET^IBCNSC4(START+2,OFFSET," -------- -------------- -------- --------------")
  1. ;
  1. S LIM=0
  1. F S LIM=$O(^IBE(355.31,LIM)) Q:'LIM D
  1. . S COV=$P($G(^IBE(355.31,LIM,0)),U,1) ; coverage category name
  1. . ;
  1. . ; check if no entry on file for this coverage category
  1. . I '$D(^IBA(355.32,"APCD",IBCPOL,LIM)) D Q
  1. .. D SET^IBCNSC4(START+LINE,OFFSET," "_$E(COV_$J("",18),1,18)_$J("",19)_"BY DEFAULT")
  1. .. S LINE=LINE+1
  1. .. Q
  1. . ;
  1. . S IBCNT=0 ; count of the number of entries displayed for each coverage category
  1. . S LEDT=""
  1. . F S LEDT=$O(^IBA(355.32,"APCD",IBCPOL,LIM,LEDT)) Q:LEDT="" D
  1. .. S COVFN=+$O(^IBA(355.32,"APCD",IBCPOL,LIM,+LEDT,""))
  1. .. S COVD=$G(^IBA(355.32,+COVFN,0))
  1. .. ;
  1. .. S IBCNT=IBCNT+1
  1. .. S X1=" "_$E($S(IBCNT=1:COV,1:"")_$J("",18),1,18) ; Don't dup category name display
  1. .. 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)
  1. .. D SET^IBCNSC4(START+LINE,OFFSET,X1)
  1. .. I '$O(^IBA(355.32,COVFN,2,0)) S LINE=LINE+1
  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
  1. .. Q
  1. . Q
  1. ;
  1. D LASTEDT ;IB*763/CKB
  1. ;
  1. S IBLCNT=LINE-3
  1. Q
  1. ;
  1. LASTEDT ; Display last edited info, who and when ;IB*763/CKB
  1. N COVFN,IBCDT,IBCBY,IENS,LASTUPD,LSTBY,LSTDT
  1. ;
  1. ; Set LASTUPD if the LAST xref doesn't exist
  1. I '$D(^IBA(355.32,"LAST",IBCPOL)) D
  1. . S LASTUPD=" COVERAGE Last Updated by "
  1. ;
  1. ; Set LASTUPD if the LAST xref DOES exist
  1. I $D(^IBA(355.32,"LAST",IBCPOL)) D
  1. . S IBCDT=$O(^IBA(355.32,"LAST",IBCPOL,"")),IBCBY=$O(^IBA(355.32,"LAST",IBCPOL,IBCDT,""))
  1. . S COVFN=$O(^IBA(355.32,"LAST",IBCPOL,IBCDT,IBCBY,"")),IENS=COVFN_","
  1. . S LSTDT=$$GET1^DIQ(355.32,IENS,1.03,"I"),LSTBY=$$GET1^DIQ(355.32,IENS,1.04,"E")
  1. . S LASTUPD=" COVERAGE Last Updated "_$$FO^IBCNEUT1($$FMTE^XLFDT(LSTDT,"5Z"),10)_" by "_LSTBY
  1. ;
  1. ; Display the LASTUPD to the screen
  1. D SET^IBCNSC4(START+LINE,OFFSET," ") S LINE=LINE+1 ;blank line
  1. D SET^IBCNSC4(START+LINE,OFFSET,LASTUPD)
  1. Q