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 Oct 16, 2024@18:24:40 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
