IBCNSA0 ;ALB/NLR - ANNUAL BENEFITS EDIT - CONTINUED ; 21-MAY-1993
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
EN ; -- entry to do actions
D POL,USERINF,ADDCOM,HOSPICE
Q
;
POL ; -- Policy information region
S IBCABD=$G(^IBA(355.4,IBCAB,0))
S IBCABC=$G(^IBA(355.3,+$P(IBCABD,U,2),0))
N OFFSET,START
S START=1,OFFSET=20
D SET^IBCNSP(START,OFFSET+6," Policy Information ",IORVON,IORVOFF)
S Y=+IBCABD D D^DIQ
S IBYE=Y
;D SET^IBCNSP(START+1,OFFSET+16,"Year: "_IBYE)
;D SET^IBCNSP(START+2,OFFSET+14,"Group: "_IBCGN)
D SET^IBCNSP(START+1,OFFSET+3,"Max. Out of Pocket: $"_$J($P(IBCABD,U,5),7))
D SET^IBCNSP(START+2,OFFSET-1,"Ambulance Coverage (%): "_$J($P(IBCABD,U,6),8)_"%")
Q
;
HOSPICE ;
S IBCABD4=$G(^IBA(355.4,+IBCAB,4))
S START=29,OFFSET=43
D SET^IBCNSP(START,OFFSET+7," Hospice ",IORVON,IORVOFF)
D SET^IBCNSP(START+1,OFFSET+2,"Annual Deductible: $"_$J($P(IBCABD4,U,1),7))
D SET^IBCNSP(START+2,OFFSET-2,"Inpatient Annual Max.: $"_$J($P(IBCABD4,U,2),7))
D SET^IBCNSP(START+3,OFFSET+6,"Lifetime Max.: $"_$J($P(IBCABD4,U,3),7))
D SET^IBCNSP(START+4,OFFSET+1,"Room and Board (%): "_$J($P(IBCABD4,U,4),8)_"%")
D SET^IBCNSP(START+5,OFFSET-4,"Other Inpt. Charges (%): "_$J($P(IBCABD4,U,5),8)_"%")
Q
USERINF ;
S IBCABD1=$G(^IBA(355.4,+IBCAB,1))
S IBDUZ=$P(IBCABD1,U,2)
S START=43,OFFSET=3
D SET^IBCNSP(START,OFFSET+1," User Information ",IORVON,IORVOFF)
D SET^IBCNSP(START+1,OFFSET+8,"Entered By: "_$P($G(^VA(200,+IBDUZ,0)),U))
D SET^IBCNSP(START+2,OFFSET+8,"Entered On: "_$$DAT1^IBOUTL($P(IBCABD1,U)))
S IBDUZ=$P(IBCABD1,U,6)
D SET^IBCNSP(START+3,OFFSET+3,"Last Updated By: "_$P($G(^VA(200,+IBDUZ,0)),U))
D SET^IBCNSP(START+4,OFFSET+3,"Last Updated On: "_$$DAT1^IBOUTL($P(IBCABD1,U,5)))
Q
ADDCOM ;
;S START=12,OFFSET=4
;D SET^IBCNSP(START,OFFSET+4," Comments ",IORVON,IORVOFF)
;D SET^IBCNSP(START+1,OFFSET+2,""_$P(IBCABD1,U,8))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNSA0 1985 printed Dec 13, 2024@02:16:47 Page 2
IBCNSA0 ;ALB/NLR - ANNUAL BENEFITS EDIT - CONTINUED ; 21-MAY-1993
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
EN ; -- entry to do actions
+1 DO POL
DO USERINF
DO ADDCOM
DO HOSPICE
+2 QUIT
+3 ;
POL ; -- Policy information region
+1 SET IBCABD=$GET(^IBA(355.4,IBCAB,0))
+2 SET IBCABC=$GET(^IBA(355.3,+$PIECE(IBCABD,U,2),0))
+3 NEW OFFSET,START
+4 SET START=1
SET OFFSET=20
+5 DO SET^IBCNSP(START,OFFSET+6," Policy Information ",IORVON,IORVOFF)
+6 SET Y=+IBCABD
DO D^DIQ
+7 SET IBYE=Y
+8 ;D SET^IBCNSP(START+1,OFFSET+16,"Year: "_IBYE)
+9 ;D SET^IBCNSP(START+2,OFFSET+14,"Group: "_IBCGN)
+10 DO SET^IBCNSP(START+1,OFFSET+3,"Max. Out of Pocket: $"_$JUSTIFY($PIECE(IBCABD,U,5),7))
+11 DO SET^IBCNSP(START+2,OFFSET-1,"Ambulance Coverage (%): "_$JUSTIFY($PIECE(IBCABD,U,6),8)_"%")
+12 QUIT
+13 ;
HOSPICE ;
+1 SET IBCABD4=$GET(^IBA(355.4,+IBCAB,4))
+2 SET START=29
SET OFFSET=43
+3 DO SET^IBCNSP(START,OFFSET+7," Hospice ",IORVON,IORVOFF)
+4 DO SET^IBCNSP(START+1,OFFSET+2,"Annual Deductible: $"_$JUSTIFY($PIECE(IBCABD4,U,1),7))
+5 DO SET^IBCNSP(START+2,OFFSET-2,"Inpatient Annual Max.: $"_$JUSTIFY($PIECE(IBCABD4,U,2),7))
+6 DO SET^IBCNSP(START+3,OFFSET+6,"Lifetime Max.: $"_$JUSTIFY($PIECE(IBCABD4,U,3),7))
+7 DO SET^IBCNSP(START+4,OFFSET+1,"Room and Board (%): "_$JUSTIFY($PIECE(IBCABD4,U,4),8)_"%")
+8 DO SET^IBCNSP(START+5,OFFSET-4,"Other Inpt. Charges (%): "_$JUSTIFY($PIECE(IBCABD4,U,5),8)_"%")
+9 QUIT
USERINF ;
+1 SET IBCABD1=$GET(^IBA(355.4,+IBCAB,1))
+2 SET IBDUZ=$PIECE(IBCABD1,U,2)
+3 SET START=43
SET OFFSET=3
+4 DO SET^IBCNSP(START,OFFSET+1," User Information ",IORVON,IORVOFF)
+5 DO SET^IBCNSP(START+1,OFFSET+8,"Entered By: "_$PIECE($GET(^VA(200,+IBDUZ,0)),U))
+6 DO SET^IBCNSP(START+2,OFFSET+8,"Entered On: "_$$DAT1^IBOUTL($PIECE(IBCABD1,U)))
+7 SET IBDUZ=$PIECE(IBCABD1,U,6)
+8 DO SET^IBCNSP(START+3,OFFSET+3,"Last Updated By: "_$PIECE($GET(^VA(200,+IBDUZ,0)),U))
+9 DO SET^IBCNSP(START+4,OFFSET+3,"Last Updated On: "_$$DAT1^IBOUTL($PIECE(IBCABD1,U,5)))
+10 QUIT
ADDCOM ;
+1 ;S START=12,OFFSET=4
+2 ;D SET^IBCNSP(START,OFFSET+4," Comments ",IORVON,IORVOFF)
+3 ;D SET^IBCNSP(START+1,OFFSET+2,""_$P(IBCABD1,U,8))
+4 QUIT
