IBCNSA0.m

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 ---IBCNSA0   1985     printed  Apr 09, 2024@21:23:51                                                                                                                                                                                                     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