- IBJTNC ;ALB/ARH - TPI INSURANCE PATIENT POLICIES ; 2/14/95
- ;;Version 2.0 ; INTEGRATED BILLING ;**39**; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ; contains list template code and protocol entry code for the insurance screens that may be called from
- ; the Active Bills screen. The actions (VI, VP, AB) are callable from the PI Patient Insurance Screen for any
- ; of the policies defined for the patient
- ;
- HDRPI ; -- IBJT NS PI VIEW PAT INS LIST TEMPLATE: patient insurance list header code
- N VA,VAERR D HDR^IBCNSM4
- Q
- ;
- INITPI ; -- IBJT NS PI VIEW PAT INS LIST TEMPLATE: patient insurance list init code
- I $G(DFN) D INIT^IBCNSM4
- Q
- ;
- EXITPI ; -- IBJT NS PI VIEW PAT INS LIST TEMPLATE: patient insurance list exit code
- K ^TMP("IBNSM",$J),^TMP("IBNSMDX",$J)
- D CLEAR^VALM1,CLEAN^VALM10
- Q
- ;
- VPI ; -- IBJT NS PI VIEW PAT INS ACTION: patient insurance list screen: displays all policies for patient
- I '$G(DFN) G VPIQ
- N IBEXP1,IBEXP2,IBCDFN,IBFILE,IBI,IBLCNT,IBN,IBCGN,IBCNT,IBDA,IBDIF,IBPPOL,IBDUZ,IBCPOL,IBCDFND1,IBCDFN,IBCNS,IBYE
- D EN^VALM("IBJT NS PI VIEW PAT INS")
- VPIQ Q
- ;
- NX(IBTPLNM) ; -- IBJT NS PI VIEW x ACTION, entry action for 3 action protocols on the Patient Insurance screen to select
- ; one of the patient policies for expanded information, opens one of the insurance screens based on the
- ; action chosen by the user
- ; IBJT NS PI VIEW INS CO SCREEN action => IBJT NS VIEW INS CO screen
- ; IBJT NS PI VIEW EXP POL SCREEN action => IBJT NS VIEW EXP POL screen
- ; IBJT NS PI VIEW AN BEN SCREEN action => IBJT NS VIEW AN BEN screen
- ;
- N VALMY,I,IBSELN,IBJPOL,IBX
- N IBCPOL,IBPPOL,IBCNS,IBI,IBVIEW,IBCHANGE,IBLCNT,IBDA,IBCNT,IBYE
- N IBEXP1,IBEXP2,IBFILE,IBN,IBCGN,IBDIF,IBDUZ,IBCDFND1,IBCDFN,IBPR,IBPRD
- N IBEVDT,IBDT,IBYR,IBCAB,IBCGN,IBDUZ,OFFSET,START,IBCNS13
- ;
- D EN^VALM2($G(XQORNOD(0)))
- D FULL^VALM1
- I $D(VALMY) S IBSELN=0 F S IBSELN=$O(VALMY(IBSELN)) Q:'IBSELN D
- . S IBX=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBSELN,0)))) Q:IBX=""
- . S IBJPOL=$P(IBX,U,4)_"^^"_$P(IBX,U,5,999)
- . D EN^VALM(IBTPLNM)
- S VALMBCK="R"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJTNC 2191 printed Jan 18, 2025@03:25:14 Page 2
- IBJTNC ;ALB/ARH - TPI INSURANCE PATIENT POLICIES ; 2/14/95
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;**39**; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 ; contains list template code and protocol entry code for the insurance screens that may be called from
- +5 ; the Active Bills screen. The actions (VI, VP, AB) are callable from the PI Patient Insurance Screen for any
- +6 ; of the policies defined for the patient
- +7 ;
- HDRPI ; -- IBJT NS PI VIEW PAT INS LIST TEMPLATE: patient insurance list header code
- +1 NEW VA,VAERR
- DO HDR^IBCNSM4
- +2 QUIT
- +3 ;
- INITPI ; -- IBJT NS PI VIEW PAT INS LIST TEMPLATE: patient insurance list init code
- +1 IF $GET(DFN)
- DO INIT^IBCNSM4
- +2 QUIT
- +3 ;
- EXITPI ; -- IBJT NS PI VIEW PAT INS LIST TEMPLATE: patient insurance list exit code
- +1 KILL ^TMP("IBNSM",$JOB),^TMP("IBNSMDX",$JOB)
- +2 DO CLEAR^VALM1
- DO CLEAN^VALM10
- +3 QUIT
- +4 ;
- VPI ; -- IBJT NS PI VIEW PAT INS ACTION: patient insurance list screen: displays all policies for patient
- +1 IF '$GET(DFN)
- GOTO VPIQ
- +2 NEW IBEXP1,IBEXP2,IBCDFN,IBFILE,IBI,IBLCNT,IBN,IBCGN,IBCNT,IBDA,IBDIF,IBPPOL,IBDUZ,IBCPOL,IBCDFND1,IBCDFN,IBCNS,IBYE
- +3 DO EN^VALM("IBJT NS PI VIEW PAT INS")
- VPIQ QUIT
- +1 ;
- NX(IBTPLNM) ; -- IBJT NS PI VIEW x ACTION, entry action for 3 action protocols on the Patient Insurance screen to select
- +1 ; one of the patient policies for expanded information, opens one of the insurance screens based on the
- +2 ; action chosen by the user
- +3 ; IBJT NS PI VIEW INS CO SCREEN action => IBJT NS VIEW INS CO screen
- +4 ; IBJT NS PI VIEW EXP POL SCREEN action => IBJT NS VIEW EXP POL screen
- +5 ; IBJT NS PI VIEW AN BEN SCREEN action => IBJT NS VIEW AN BEN screen
- +6 ;
- +7 NEW VALMY,I,IBSELN,IBJPOL,IBX
- +8 NEW IBCPOL,IBPPOL,IBCNS,IBI,IBVIEW,IBCHANGE,IBLCNT,IBDA,IBCNT,IBYE
- +9 NEW IBEXP1,IBEXP2,IBFILE,IBN,IBCGN,IBDIF,IBDUZ,IBCDFND1,IBCDFN,IBPR,IBPRD
- +10 NEW IBEVDT,IBDT,IBYR,IBCAB,IBCGN,IBDUZ,OFFSET,START,IBCNS13
- +11 ;
- +12 DO EN^VALM2($GET(XQORNOD(0)))
- +13 DO FULL^VALM1
- +14 IF $DATA(VALMY)
- SET IBSELN=0
- FOR
- SET IBSELN=$ORDER(VALMY(IBSELN))
- if 'IBSELN
- QUIT
- Begin DoDot:1
- +15 SET IBX=$GET(^TMP("IBNSMDX",$JOB,$ORDER(^TMP("IBNSM",$JOB,"IDX",IBSELN,0))))
- if IBX=""
- QUIT
- +16 SET IBJPOL=$PIECE(IBX,U,4)_"^^"_$PIECE(IBX,U,5,999)
- +17 DO EN^VALM(IBTPLNM)
- End DoDot:1
- +18 SET VALMBCK="R"
- +19 QUIT