| 1 | IBNCPDPI ;DALOI/SS - for ECME SCREEN INSURANCE VIEW AND UTILITIES ;05-APR-05
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**276**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ; -- main entry point
|
|---|
| 5 | Q
|
|---|
| 6 | EN ;
|
|---|
| 7 | Q
|
|---|
| 8 | EN1(DFN) ;
|
|---|
| 9 | I $G(DFN)'>0 Q
|
|---|
| 10 | Q:$$PFSSON() ;quit if PFSS is ON
|
|---|
| 11 | N J,POP,START,X,VA,ALMBG,DIC,DT,C,CTRLCOL,DILN
|
|---|
| 12 | ;
|
|---|
| 13 | ;if the user does have IB keys to edit insurances
|
|---|
| 14 | I $D(^XUSEC("IB INSURANCE SUPERVISOR",DUZ))!($D(^XUSEC("IB INSURANCE COMPANY ADD",DUZ))) D Q
|
|---|
| 15 | . N D1,DA,DDER,DDH,DIE,DR,I
|
|---|
| 16 | . N IBCH,IBCNS,IBCNSEH,IBCNT,IBCPOL,IBDT,IBDUZ,IBFILE,IBLCNT,IBN,IBNEW,IBPPOL
|
|---|
| 17 | . N IBTYP,IBYE,IBCDFN,IBCDFND1,IBCGN
|
|---|
| 18 | . D EN^VALM("IBNCPDP INSURANCE MANAGEMENT")
|
|---|
| 19 | ;if the user doesn't have insurance IB keys
|
|---|
| 20 | D
|
|---|
| 21 | . N D0,IBCAB,IBCDFN,IBCDFND1,IBCNS,IBCNT,IBCPOL,IBDT,IBEXP1
|
|---|
| 22 | . N IBEXP2,IBFILE,IBLCNT,IBN,IBPPOL
|
|---|
| 23 | . D EN1^IBNCPDPV(DFN)
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | INIT ; -- set up initial variables
|
|---|
| 27 | ;DFN should be defined
|
|---|
| 28 | I '$D(DFN) Q
|
|---|
| 29 | S U="^",VALMCNT=0,VALMBG=1
|
|---|
| 30 | K ^TMP("IBNSM",$J),^TMP("IBNSMDX",$J)
|
|---|
| 31 | S IBTYP="P"
|
|---|
| 32 | D BLD^IBCNSM
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | HDR ; -- screen header for initial screen
|
|---|
| 36 | D HDR^IBCNSM
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | HELP ; -- help code
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | EXIT ; -- exit code
|
|---|
| 43 | Q
|
|---|
| 44 | ;
|
|---|
| 45 | EXPND ; -- expand code
|
|---|
| 46 | Q
|
|---|
| 47 | ;
|
|---|
| 48 | ;check if PFSS On?
|
|---|
| 49 | ;returns:
|
|---|
| 50 | ; 1 - PFSS is ON
|
|---|
| 51 | ; 0 - PFSS is OFF or not installed
|
|---|
| 52 | PFSSON() ;
|
|---|
| 53 | N BPST
|
|---|
| 54 | S BPST=0
|
|---|
| 55 | I $L($T(SWSTAT^IBBAPI))>0 S BPST=+$$SWSTAT^IBBAPI()
|
|---|
| 56 | I BPST=1 D Q 1
|
|---|
| 57 | . W !,"This functionality is not supported on PFSS sites." D PAUSE^VALM1
|
|---|
| 58 | Q 0
|
|---|
| 59 | ;**
|
|---|
| 60 | ;API for ECME (DBIA #4721)
|
|---|
| 61 | ;Insurance Company lookup API
|
|---|
| 62 | ;NOTE: PFSS needs to modify this code to return back values
|
|---|
| 63 | ; from the appropriate PFSS file instead of ALL ("0")
|
|---|
| 64 | ;input:
|
|---|
| 65 | ; PRMTMSG - prompt message
|
|---|
| 66 | ; DFLTVAL - INSURANCE NAME as a default value for the prompt (optional)
|
|---|
| 67 | ;output:
|
|---|
| 68 | ; IEN^INSURANCE_NAME^PFSS_STATUS
|
|---|
| 69 | ; 0^^PFSS_STATUS means ALL selected (temporary solution for PFSS sites)
|
|---|
| 70 | ; -1^^PFSS_STATUS nothing was selected, timeout expired or uparrow entered
|
|---|
| 71 | ; where: IEN is record number in file #36.
|
|---|
| 72 | ; PFSS_STATUS - the value returned by the PFSS switch: 0 - OFF, 1- ON
|
|---|
| 73 | SELINSUR(PRMTMSG,DFLTVAL) ;*/
|
|---|
| 74 | N Y,DUOUT,DTOUT,IBQUIT,DIROUT,IBPFSS
|
|---|
| 75 | S IBPFSS=$$PFSSON()
|
|---|
| 76 | ;PFSS needs to modify this code to return back
|
|---|
| 77 | ;selection in new PFSS file instead of ALL ("0")
|
|---|
| 78 | I IBPFSS=1 Q "0^^"_IBPFSS
|
|---|
| 79 | S IBQUIT=0
|
|---|
| 80 | N DIC
|
|---|
| 81 | S DIC="^DIC(36,"
|
|---|
| 82 | S DIC(0)="AEMNQ"
|
|---|
| 83 | S:$L($G(DFLTVAL))>0 DIC("B")=DFLTVAL
|
|---|
| 84 | S DIC("A")=PRMTMSG_": "
|
|---|
| 85 | D ^DIC
|
|---|
| 86 | I (Y=-1)!$D(DUOUT)!$D(DTOUT) S IBQUIT=1
|
|---|
| 87 | I IBQUIT=1 Q "-1^^"_IBPFSS
|
|---|
| 88 | Q Y_U_IBPFSS
|
|---|
| 89 | ;
|
|---|
| 90 | ;API for ECME (DBIA #4729)
|
|---|
| 91 | ;Determine Bill# and Account Receivable information about the bill
|
|---|
| 92 | ;input:
|
|---|
| 93 | ; IBRX - pointer to file #52 (internal prescription number)
|
|---|
| 94 | ; IBREF - re-fill number
|
|---|
| 95 | ;output:
|
|---|
| 96 | ;Returns a string of information about the bill requested:
|
|---|
| 97 | ; piece #1: Bill number (field(#.01) of file (#399))
|
|---|
| 98 | ; piece #2: Original Amount of bill
|
|---|
| 99 | ; piece #3: Current Status (pointer to file #430.3)
|
|---|
| 100 | ; piece #4: Current Balance
|
|---|
| 101 | ; piece #5: Total Collected
|
|---|
| 102 | ; piece #6: % Collected Returns null if no data or bill found.
|
|---|
| 103 | ; piece #7: PFSS switch status: 0-OFF, 1-ON
|
|---|
| 104 | ;On PFSS site the API will always return "^^^^^^1"
|
|---|
| 105 | ;
|
|---|
| 106 | BILLINFO(IBRX,IBREF) ;
|
|---|
| 107 | N IBIEN,IBBNUM,RCRET
|
|---|
| 108 | N IBPFSS,IBRETV
|
|---|
| 109 | S RCRET="",IBRETV=""
|
|---|
| 110 | S IBPFSS=$$PFSSON()
|
|---|
| 111 | I IBPFSS=1 S $P(IBRETV,U,7)=IBPFSS Q IBRETV
|
|---|
| 112 | S IBBNUM=$$BILL^IBNCPDPU(IBRX,IBREF)
|
|---|
| 113 | I IBBNUM]"" D
|
|---|
| 114 | .S IBIEN=$O(^DGCR(399,"B",IBBNUM,"")) Q:IBIEN=""
|
|---|
| 115 | .S RCRET=$$BILL^RCJIBFN2(IBIEN)
|
|---|
| 116 | S IBRETV=IBBNUM_U_RCRET
|
|---|
| 117 | S $P(IBRETV,U,7)=IBPFSS
|
|---|
| 118 | Q IBRETV
|
|---|
| 119 | ;
|
|---|
| 120 | ;entry point for TPJI option of the ECME User Screen
|
|---|
| 121 | TPJI(DFN) ;
|
|---|
| 122 | Q:$$PFSSON() ;quit if PFSS is ON
|
|---|
| 123 | I DFN>0 D EN^IBJTLA
|
|---|
| 124 | Q
|
|---|
| 125 | ;
|
|---|
