- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNBLE.m
r613 r623 1 IBCNBLE ;ALB/ARH-Ins Buffer: LM buffer entry screen ;1 Jun 97 2 ;;2.0;INTEGRATED BILLING;**82,231,184,251,371**;21-MAR-94;Build 57 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 EN ; - main entry point for list manager display 6 N DFN 7 D EN^VALM("IBCNB INSURANCE BUFFER ENTRY") 8 Q 9 ; 10 HDR ; - header code for list manager display 11 N IBX,IB0,VADM,VA,VAERR S IBX="" 12 I +$G(DFN) D DEM^VADPT S IBX=$E(VADM(1),1,28),IBX=IBX_$J("",35-$L(IBX))_$P(VADM(2),U,2)_" DOB: "_$P(VADM(3),U,2)_" AGE: "_VADM(4) 13 S VALMHDR(1)=IBX 14 S IB0=$G(^IBA(355.33,+$G(IBBUFDA),0)) 15 S IBX=$E($P($G(^VA(200,+$P(IB0,U,2),0)),U,1),1,27)_" ("_$E($$EXPAND^IBTRE(355.33,.03,$P(IB0,U,3)),1,11)_")" 16 S IBX="Buffer entry created on "_$$DATE(+IB0)_" by "_IBX,IBX=$J("",40-($L(IBX)\2))_IBX 17 S VALMHDR(2)=IBX 18 S IBX="" I +$P(IB0,U,10) S IBX="Buffer entry verified on "_$$DATE(+$P(IB0,U,10))_" by "_$E($P($G(^VA(200,+$P(IB0,U,11),0)),U,1),1,27),IBX=$J("",40-($L(IBX)\2))_IBX 19 S VALMHDR(3)=IBX 20 Q 21 ; 22 INIT ; - initialization of list manager screen, ifn of record to display required IBBUFDA 23 K ^TMP("IBCNBLE",$J) 24 I '$G(IBBUFDA) S VALMQUIT="" Q 25 S DFN=+$G(^IBA(355.33,IBBUFDA,60)) 26 D BLD 27 Q 28 ; 29 HELP ; - help text for list manager screen 30 D FULL^VALM1 31 W !!,"This screen displays all data in a Buffer File entry." 32 W !!,"The actions allow editing of all data and verification of coverage." 33 W !!,"It is not necessary to use the Verify Entry action, this action is optional.",!,"If the Verify Entry action is not used, the policy will be automatically flagged",!,"as verified when it is Accepted and stored in the main Insurance files." 34 D PAUSE^VALM1 S VALMBCK="R" 35 Q 36 ; 37 EXIT ; - exit list manager screen 38 K ^TMP("IBCNBLE",$J) 39 D CLEAR^VALM1 40 Q 41 ; 42 BLD ; display buffer entry 43 N IB0,IB20,IB40,IB60,IB61,IB62,IBL,IBLINE,ADDR,IBI,IBY 44 S VALMCNT=0 45 S IB0=$G(^IBA(355.33,IBBUFDA,0)),IB20=$G(^IBA(355.33,IBBUFDA,20)),IB40=$G(^IBA(355.33,IBBUFDA,40)) 46 S IB60=$G(^IBA(355.33,IBBUFDA,60)),IB61=$G(^IBA(355.33,IBBUFDA,61)),IB62=$G(^IBA(355.33,IBBUFDA,62)) 47 ; 48 D SET(" ") S IBY=$J("",26)_"Insurance Company Information" D SET(IBY,"B") S IBLINE="" 49 S IBL="Name: ",IBY=$P(IB20,U,1) S IBLINE=$$SETL("",IBY,IBL,10,30) 50 S IBL="Reimburse?: ",IBY=$$EXPAND^IBTRE(355.33,20.05,$P(IB20,U,5)) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20) 51 D SET(IBLINE) S IBLINE="" 52 S IBL="Phone: ",IBY=$P(IB20,U,2) S IBLINE=$$SETL(IBLINE,IBY,IBL,10,20) 53 S IBL="Billing Phone: ",IBY=$P(IB20,U,3) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20) 54 D SET(IBLINE) S IBLINE="" 55 S IBL="Precert Phone: ",IBY=$P(IB20,U,4) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20) 56 D SET(IBLINE) S IBLINE="" 57 S IBL="Remote Query From: ",IBY=$$EXTERNAL^DILFD(355.33,.14,"",$P(IB0,"^",14)) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20) 58 D SET(IBLINE) S IBLINE="" D ADDR(21,1) 59 S IBL="Address: ",IBY=ADDR(1) S IBLINE=$$SETL(IBLINE,IBY,IBL,10,69) 60 D SET(IBLINE) S IBLINE="" 61 F IBI=2:1:9 S IBL="",IBY=$G(ADDR(IBI)) Q:IBY="" S IBLINE=$$SETL(IBLINE,IBY,IBL,10,69) D SET(IBLINE) S IBLINE="" 62 ; 63 D SET(" ") S IBY=$J("",29)_"Group/Plan Information" D SET(IBY,"B") S IBLINE="" 64 S IBL="Group Plan?: ",IBY=$$YN($P(IB40,U,1)) S IBLINE=$$SETL("",IBY,IBL,16,3) 65 S IBL="Require UR: ",IBY=$$YN($P(IB40,U,4)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3) 66 D SET(IBLINE) S IBLINE="" 67 S IBL="Group Name: ",IBY=$P(IB40,U,2) S IBLINE=$$SETL("",IBY,IBL,16,20) 68 S IBL="Require Amb Cert: ",IBY=$$YN($P(IB40,U,6)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3) 69 D SET(IBLINE) S IBLINE="" 70 S IBL="Group Number: ",IBY=$P(IB40,U,3) S IBLINE=$$SETL("",IBY,IBL,16,17) 71 S IBL="Require Pre-Cert: ",IBY=$$YN($P(IB40,U,5)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3) 72 ;;Daou/EEN - Adding BIN and PCN 73 D SET(IBLINE) S IBLINE="" 74 S IBL="BIN: ",IBY=$P(IB40,U,10) S IBLINE=$$SETL("",IBY,IBL,16,10) 75 D SET(IBLINE) S IBLINE="" 76 S IBL="PCN: ",IBY=$P(IB40,U,11) S IBLINE=$$SETL("",IBY,IBL,16,20) 77 D SET(IBLINE) S IBLINE="" 78 S IBL="Type of Plan: ",IBY=$P($G(^IBE(355.1,+$P(IB40,U,9),0)),U,1) S IBLINE=$$SETL("",IBY,IBL,16,25) 79 S IBL="Exclude Pre-Cond: ",IBY=$$YN($P(IB40,U,7)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3) 80 D SET(IBLINE) S IBLINE="" 81 S IBL="Benefits Assignable: ",IBY=$$YN($P(IB40,U,8)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3) 82 D SET(IBLINE) S IBLINE="" 83 ; 84 D SET(" ") S IBY=$J("",26)_"Policy/Subscriber Information" D SET(IBY,"B") S IBLINE="" 85 S IBL="Whose Insurance: ",IBY=$$EXPAND^IBTRE(355.33,60.05,$P(IB60,U,5)) S IBLINE=$$SETL("",IBY,IBL,18,7) 86 S IBL="Effective: ",IBY=$$DATE($P(IB60,U,2)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,8) 87 D SET(IBLINE) S IBLINE="" 88 S IBL="Insured's Name: ",IBY=$P(IB60,U,7) S IBLINE=$$SETL("",IBY,IBL,18,30) 89 S IBL="Expiration: ",IBY=$$DATE($P(IB60,U,3)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,13) 90 D SET(IBLINE) S IBLINE="" 91 S IBL="Subscriber Id: ",IBY=$P(IB60,U,4) S IBLINE=$$SETL("",IBY,IBL,18,20) 92 S IBL="Primary Provider: ",IBY=$P(IB60,U,10) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17) 93 D SET(IBLINE) S IBLINE="" 94 S IBL="Relationship: ",IBY=$$EXPAND^IBTRE(355.33,60.06,$P(IB60,U,6)) S IBLINE=$$SETL("",IBY,IBL,18,16) 95 S IBL="Provider Phone: ",IBY=$P(IB60,U,11) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,16) 96 D SET(IBLINE) S IBLINE="" 97 I $P(IB60,U,6)'="01"!($P(IB60,U,8)'="") S IBL="Insured's DOB: ",IBY=$$DATE($P(IB60,U,8)) S IBLINE=$$SETL("",IBY,IBL,18,8) 98 S IBL="Coord of Benefits: ",IBY=$$EXPAND^IBTRE(355.33,60.12,$P(IB60,U,12)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,16) 99 D SET(IBLINE) S IBLINE="" 100 I $P(IB62,U)'="" S IBL="Patient Id: ",IBY=$P(IB62,U) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,13) 101 I IBLINE'="" D SET(IBLINE) S IBLINE="" 102 ; 103 I '$P(IB61,U,1) D SET(" ") S IBL="Employer Sponsored Group Health Plan?: ",IBY=$$YN($P(IB61,U,1)) S IBLINE=$$SETL("",IBY,IBL,40,3) D SET(IBLINE) S IBLINE="" G NXT 104 ; 105 D ADDR(61,6) 106 D SET(" ") S IBY=$J("",24)_"Subscriber's Employer Information" D SET(IBY,"B") S IBLINE="" 107 S IBL="Employer Sponsored?: ",IBY=$$YN($P(IB61,U,1)) S IBLINE=$$SETL("",IBY,IBL,22,3) 108 S IBL="Employment Status: ",IBY=$$EXPAND^IBTRE(355.33,61.03,$P(IB61,U,3)) S IBLINE=$$SETL(IBLINE,IBY,IBL,64,15) 109 D SET(IBLINE) S IBLINE="" 110 S IBL="Claim to Employer: ",IBY=$$YN($P(IB61,U,5)) S IBLINE=$$SETL("",IBY,IBL,22,3) 111 S IBL="Retirement Date: ",IBY=$$DATE($P(IB61,U,4)) S IBLINE=$$SETL(IBLINE,IBY,IBL,64,8) 112 D SET(IBLINE) S IBLINE="" 113 S IBL="Employer Name: ",IBY=$P(IB61,U,2) S IBLINE=$$SETL("",IBY,IBL,16,30) 114 S IBL="Employer Phone: ",IBY=$P(IB61,U,12) S IBLINE=$$SETL(IBLINE,IBY,IBL,64,15) 115 D SET(IBLINE) S IBLINE="" 116 S IBL="Address: ",IBY=ADDR(1) S IBLINE=$$SETL(IBLINE,IBY,IBL,16,64) 117 D SET(IBLINE) S IBLINE="" 118 F IBI=2:1:9 S IBL="",IBY=$G(ADDR(IBI)) Q:IBY="" S IBLINE=$$SETL(IBLINE,IBY,IBL,16,64) D SET(IBLINE) S IBLINE="" 119 ; 120 NXT ; 121 D SET(" ") S IBY=$J("",26)_"Buffer Entry Information" D SET(IBY,"B") S IBLINE="" 122 S IBL="Date Entered: ",IBY=$$FMTE^XLFDT($P(IB0,U,1),2) S IBLINE=$$SETL("",IBY,IBL,18,17) 123 S IBL="Date Verified: ",IBY=$$FMTE^XLFDT($P(IB0,U,10),2) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17) 124 D SET(IBLINE) S IBLINE="" 125 S IBL="Entered By: ",IBY=$$EXPAND^IBTRE(355.33,.02,$P(IB0,U,2)) S IBLINE=$$SETL("",IBY,IBL,18,40) 126 S IBL="Verified By: ",IBY=$$EXPAND^IBTRE(355.33,.11,$P(IB0,U,11)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17) 127 D SET(IBLINE) S IBLINE="" 128 ; 129 ; esg - 6/25/02 SDD 5.1.2 - modifications to Expand Entry for IIV 130 ; move source down one line, eIIV trace # to the left column and add 131 ; eIIV processed date to the right column 132 ; 133 S IBLINE=$$TRACE(IBLINE,IBBUFDA) ; eIIV trace # 134 S IBL="eIIV Processed Date: ",IBY=$S($P(IB0,U,15)="":"",1:$$FMTE^XLFDT($P(IB0,U,15),"2M")) 135 S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17) 136 D SET(IBLINE) S IBLINE="" 137 S IBL="Source: ",IBY=$$EXPAND^IBTRE(355.33,.03,$P(IB0,U,3)) 138 S IBLINE=$$SETL("",IBY,IBL,18,17) 139 D SET(IBLINE) S IBLINE="" 140 ; 141 ; Call another routine for continuation of list build 142 D BLD^IBCNBLE1 143 ; 144 BLDQ Q 145 ; 146 ; 147 SETL(LINE,DATA,LABEL,COL,LNG) ; 148 S LINE=LINE_$J("",(COL-$L(LABEL)-$L(LINE)))_LABEL_$E(DATA,1,LNG) 149 Q LINE 150 ; 151 SET(LINE,SPEC) ; 152 S VALMCNT=VALMCNT+1 153 S ^TMP("IBCNBLE",$J,VALMCNT,0)=LINE 154 I $G(SPEC)="B" D CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM) 155 Q 156 ; 157 DATE(X) ; 158 N Y S Y="" I X?7N.E S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3) 159 Q Y 160 ; 161 YN(X) ; 162 N Y S X=$G(X),Y=$S(X=1:"Yes",X=0:"No",1:"") 163 Q Y 164 ; 165 ADDR(NODE,FLD) ; format address for output 166 N IBY,IB0,IBCS,IBST,IBZIP,IBJ,IBZ,IBX K ADDR S ADDR(1)="" 167 S IB0=$G(^IBA(355.33,IBBUFDA,NODE)) 168 S IBCS=$P(IB0,U,FLD+3),IBST=$P($G(^DIC(5,+$P(IB0,U,FLD+4),0)),U,2),IBZIP=$P(IB0,U,FLD+5) 169 S IBZIP=$E(IBZIP,1,5)_$S($E(IBZIP,6,9)'="":"-"_$E(IBZIP,6,9),1:"") 170 S IBST=IBST_$S(IBST=""!(IBZIP=""):"",1:" ")_IBZIP 171 S IBCS=IBCS_$S(IBCS=""!(IBST=""):"",1:", ")_IBST 172 ; 173 S IBJ=1 F IBY=$P(IB0,U,FLD),$P(IB0,U,(FLD+1)),$P(IB0,U,(FLD+2)),IBCS I IBY'="" S IBX=$G(ADDR(IBJ)),IBZ=", " D 174 . S:IBX="" IBZ="" S:($L(IBX)+2+$L(IBY))>64 IBZ="",IBJ=IBJ+1 175 . S ADDR(IBJ)=$G(ADDR(IBJ))_IBZ_IBY 176 Q 177 ; 178 TRACE(IBLINE,IBBUFDA) ; Add the eIIV Trace Number to the display 179 NEW RESP,TRACENUM,IBL,IBY 180 I '$G(IBBUFDA) G TRACEX 181 S RESP=$O(^IBCN(365,"AF",IBBUFDA,""),-1) ; response ien 182 S TRACENUM="" 183 I RESP S TRACENUM=$P($G(^IBCN(365,RESP,0)),U,9) ; trace# field 184 S IBL="eIIV Trace #: ",IBY=TRACENUM ; field label/data 185 S IBLINE=$$SETL("",IBY,IBL,18,17) ; add it 186 TRACEX ; 187 Q IBLINE 188 ; 1 IBCNBLE ;ALB/ARH-Ins Buffer: LM buffer entry screen ;1 Jun 97 2 ;;2.0;INTEGRATED BILLING;**82,231,184,251**;21-MAR-94 3 ;;Per VHA Directive 10-93-142, this routine should not be modified. 4 ; 5 EN ; - main entry point for list manager display 6 N DFN 7 D EN^VALM("IBCNB INSURANCE BUFFER ENTRY") 8 Q 9 ; 10 HDR ; - header code for list manager display 11 N IBX,IB0,VADM,VA,VAERR S IBX="" 12 I +$G(DFN) D DEM^VADPT S IBX=$E(VADM(1),1,28),IBX=IBX_$J("",35-$L(IBX))_$P(VADM(2),U,2)_" DOB: "_$P(VADM(3),U,2)_" AGE: "_VADM(4) 13 S VALMHDR(1)=IBX 14 S IB0=$G(^IBA(355.33,+$G(IBBUFDA),0)) 15 S IBX=$E($P($G(^VA(200,+$P(IB0,U,2),0)),U,1),1,27)_" ("_$E($$EXPAND^IBTRE(355.33,.03,$P(IB0,U,3)),1,11)_")" 16 S IBX="Buffer entry created on "_$$DATE(+IB0)_" by "_IBX,IBX=$J("",40-($L(IBX)\2))_IBX 17 S VALMHDR(2)=IBX 18 S IBX="" I +$P(IB0,U,10) S IBX="Buffer entry verified on "_$$DATE(+$P(IB0,U,10))_" by "_$E($P($G(^VA(200,+$P(IB0,U,11),0)),U,1),1,27),IBX=$J("",40-($L(IBX)\2))_IBX 19 S VALMHDR(3)=IBX 20 Q 21 ; 22 INIT ; - initialization of list manager screen, ifn of record to display required IBBUFDA 23 K ^TMP("IBCNBLE",$J) 24 I '$G(IBBUFDA) S VALMQUIT="" Q 25 S DFN=+$G(^IBA(355.33,IBBUFDA,60)) 26 D BLD 27 Q 28 ; 29 HELP ; - help text for list manager screen 30 D FULL^VALM1 31 W !!,"This screen displays all data in a Buffer File entry." 32 W !!,"The actions allow editing of all data and verification of coverage." 33 W !!,"It is not necessary to use the Verify Entry action, this action is optional.",!,"If the Verify Entry action is not used, the policy will be automatically flagged",!,"as verified when it is Accepted and stored in the main Insurance files." 34 D PAUSE^VALM1 S VALMBCK="R" 35 Q 36 ; 37 EXIT ; - exit list manager screen 38 K ^TMP("IBCNBLE",$J) 39 D CLEAR^VALM1 40 Q 41 ; 42 BLD ; display buffer entry 43 N IB0,IB20,IB40,IB60,IB61,IBL,IBLINE,ADDR,IBI,IBY 44 S VALMCNT=0 45 S IB0=$G(^IBA(355.33,IBBUFDA,0)),IB20=$G(^IBA(355.33,IBBUFDA,20)),IB40=$G(^IBA(355.33,IBBUFDA,40)),IB60=$G(^IBA(355.33,IBBUFDA,60)),IB61=$G(^IBA(355.33,IBBUFDA,61)) 46 ; 47 D SET(" ") S IBY=$J("",26)_"Insurance Company Information" D SET(IBY,"B") S IBLINE="" 48 S IBL="Name: ",IBY=$P(IB20,U,1) S IBLINE=$$SETL("",IBY,IBL,10,30) 49 S IBL="Reimburse?: ",IBY=$$EXPAND^IBTRE(355.33,20.05,$P(IB20,U,5)) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20) 50 D SET(IBLINE) S IBLINE="" 51 S IBL="Phone: ",IBY=$P(IB20,U,2) S IBLINE=$$SETL(IBLINE,IBY,IBL,10,20) 52 S IBL="Billing Phone: ",IBY=$P(IB20,U,3) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20) 53 D SET(IBLINE) S IBLINE="" 54 S IBL="Precert Phone: ",IBY=$P(IB20,U,4) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20) 55 D SET(IBLINE) S IBLINE="" 56 S IBL="Remote Query From: ",IBY=$$EXTERNAL^DILFD(355.33,.14,"",$P(IB0,"^",14)) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20) 57 D SET(IBLINE) S IBLINE="" D ADDR(21,1) 58 S IBL="Address: ",IBY=ADDR(1) S IBLINE=$$SETL(IBLINE,IBY,IBL,10,69) 59 D SET(IBLINE) S IBLINE="" 60 F IBI=2:1:9 S IBL="",IBY=$G(ADDR(IBI)) Q:IBY="" S IBLINE=$$SETL(IBLINE,IBY,IBL,10,69) D SET(IBLINE) S IBLINE="" 61 ; 62 D SET(" ") S IBY=$J("",29)_"Group/Plan Information" D SET(IBY,"B") S IBLINE="" 63 S IBL="Group Plan?: ",IBY=$$YN($P(IB40,U,1)) S IBLINE=$$SETL("",IBY,IBL,16,3) 64 S IBL="Require UR: ",IBY=$$YN($P(IB40,U,4)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3) 65 D SET(IBLINE) S IBLINE="" 66 S IBL="Group Name: ",IBY=$P(IB40,U,2) S IBLINE=$$SETL("",IBY,IBL,16,20) 67 S IBL="Require Amb Cert: ",IBY=$$YN($P(IB40,U,6)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3) 68 D SET(IBLINE) S IBLINE="" 69 S IBL="Group Number: ",IBY=$P(IB40,U,3) S IBLINE=$$SETL("",IBY,IBL,16,17) 70 S IBL="Require Pre-Cert: ",IBY=$$YN($P(IB40,U,5)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3) 71 ;;Daou/EEN - Adding BIN and PCN 72 D SET(IBLINE) S IBLINE="" 73 S IBL="BIN: ",IBY=$P(IB40,U,10) S IBLINE=$$SETL("",IBY,IBL,16,10) 74 D SET(IBLINE) S IBLINE="" 75 S IBL="PCN: ",IBY=$P(IB40,U,11) S IBLINE=$$SETL("",IBY,IBL,16,20) 76 D SET(IBLINE) S IBLINE="" 77 S IBL="Type of Plan: ",IBY=$P($G(^IBE(355.1,+$P(IB40,U,9),0)),U,1) S IBLINE=$$SETL("",IBY,IBL,16,25) 78 S IBL="Exclude Pre-Cond: ",IBY=$$YN($P(IB40,U,7)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3) 79 D SET(IBLINE) S IBLINE="" 80 S IBL="Benefits Assignable: ",IBY=$$YN($P(IB40,U,8)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3) 81 D SET(IBLINE) S IBLINE="" 82 ; 83 D SET(" ") S IBY=$J("",26)_"Policy/Subscriber Information" D SET(IBY,"B") S IBLINE="" 84 S IBL="Whose Insurance: ",IBY=$$EXPAND^IBTRE(355.33,60.05,$P(IB60,U,5)) S IBLINE=$$SETL("",IBY,IBL,18,7) 85 S IBL="Effective: ",IBY=$$DATE($P(IB60,U,2)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,8) 86 D SET(IBLINE) S IBLINE="" 87 S IBL="Insured's Name: ",IBY=$P(IB60,U,7) S IBLINE=$$SETL("",IBY,IBL,18,30) 88 S IBL="Expiration: ",IBY=$$DATE($P(IB60,U,3)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,13) 89 D SET(IBLINE) S IBLINE="" 90 S IBL="Subscriber Id: ",IBY=$P(IB60,U,4) S IBLINE=$$SETL("",IBY,IBL,18,20) 91 S IBL="Primary Provider: ",IBY=$P(IB60,U,10) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17) 92 D SET(IBLINE) S IBLINE="" 93 S IBL="Relationship: ",IBY=$$EXPAND^IBTRE(355.33,60.06,$P(IB60,U,6)) S IBLINE=$$SETL("",IBY,IBL,18,16) 94 S IBL="Provider Phone: ",IBY=$P(IB60,U,11) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,16) 95 D SET(IBLINE) S IBLINE="" 96 I $P(IB60,U,6)'="01"!($P(IB60,U,8)'="") S IBL="Insured's DOB: ",IBY=$$DATE($P(IB60,U,8)) S IBLINE=$$SETL("",IBY,IBL,18,8) 97 S IBL="Coord of Benefits: ",IBY=$$EXPAND^IBTRE(355.33,60.12,$P(IB60,U,12)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,16) 98 D SET(IBLINE) S IBLINE="" 99 I $P(IB60,U,6)'="01"!($P(IB60,U,9)'="") S IBL="Insured's SSN: ",IBY=$P(IB60,U,9) S IBLINE=$$SETL("",IBY,IBL,18,13) 100 I IBLINE'="" D SET(IBLINE) S IBLINE="" 101 ; 102 I '$P(IB61,U,1) D SET(" ") S IBL="Employer Sponsored Group Health Plan?: ",IBY=$$YN($P(IB61,U,1)) S IBLINE=$$SETL("",IBY,IBL,40,3) D SET(IBLINE) S IBLINE="" G NXT 103 ; 104 D ADDR(61,6) 105 D SET(" ") S IBY=$J("",24)_"Subscriber's Employer Information" D SET(IBY,"B") S IBLINE="" 106 S IBL="Employer Sponsored?: ",IBY=$$YN($P(IB61,U,1)) S IBLINE=$$SETL("",IBY,IBL,22,3) 107 S IBL="Employment Status: ",IBY=$$EXPAND^IBTRE(355.33,61.03,$P(IB61,U,3)) S IBLINE=$$SETL(IBLINE,IBY,IBL,64,15) 108 D SET(IBLINE) S IBLINE="" 109 S IBL="Claim to Employer: ",IBY=$$YN($P(IB61,U,5)) S IBLINE=$$SETL("",IBY,IBL,22,3) 110 S IBL="Retirement Date: ",IBY=$$DATE($P(IB61,U,4)) S IBLINE=$$SETL(IBLINE,IBY,IBL,64,8) 111 D SET(IBLINE) S IBLINE="" 112 S IBL="Employer Name: ",IBY=$P(IB61,U,2) S IBLINE=$$SETL("",IBY,IBL,16,30) 113 S IBL="Employer Phone: ",IBY=$P(IB61,U,12) S IBLINE=$$SETL(IBLINE,IBY,IBL,64,15) 114 D SET(IBLINE) S IBLINE="" 115 S IBL="Address: ",IBY=ADDR(1) S IBLINE=$$SETL(IBLINE,IBY,IBL,16,64) 116 D SET(IBLINE) S IBLINE="" 117 F IBI=2:1:9 S IBL="",IBY=$G(ADDR(IBI)) Q:IBY="" S IBLINE=$$SETL(IBLINE,IBY,IBL,16,64) D SET(IBLINE) S IBLINE="" 118 ; 119 NXT ; 120 D SET(" ") S IBY=$J("",26)_"Buffer Entry Information" D SET(IBY,"B") S IBLINE="" 121 S IBL="Date Entered: ",IBY=$$FMTE^XLFDT($P(IB0,U,1),2) S IBLINE=$$SETL("",IBY,IBL,18,17) 122 S IBL="Date Verified: ",IBY=$$FMTE^XLFDT($P(IB0,U,10),2) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17) 123 D SET(IBLINE) S IBLINE="" 124 S IBL="Entered By: ",IBY=$$EXPAND^IBTRE(355.33,.02,$P(IB0,U,2)) S IBLINE=$$SETL("",IBY,IBL,18,40) 125 S IBL="Verified By: ",IBY=$$EXPAND^IBTRE(355.33,.11,$P(IB0,U,11)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17) 126 D SET(IBLINE) S IBLINE="" 127 ; 128 ; esg - 6/25/02 SDD 5.1.2 - modifications to Expand Entry for IIV 129 ; move source down one line, eIIV trace # to the left column and add 130 ; eIIV processed date to the right column 131 ; 132 S IBLINE=$$TRACE(IBLINE,IBBUFDA) ; eIIV trace # 133 S IBL="eIIV Processed Date: ",IBY=$S($P(IB0,U,15)="":"",1:$$FMTE^XLFDT($P(IB0,U,15),"2M")) 134 S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17) 135 D SET(IBLINE) S IBLINE="" 136 S IBL="Source: ",IBY=$$EXPAND^IBTRE(355.33,.03,$P(IB0,U,3)) 137 S IBLINE=$$SETL("",IBY,IBL,18,17) 138 D SET(IBLINE) S IBLINE="" 139 ; 140 ; Call another routine for continuation of list build 141 D BLD^IBCNBLE1 142 ; 143 BLDQ Q 144 ; 145 ; 146 SETL(LINE,DATA,LABEL,COL,LNG) ; 147 S LINE=LINE_$J("",(COL-$L(LABEL)-$L(LINE)))_LABEL_$E(DATA,1,LNG) 148 Q LINE 149 ; 150 SET(LINE,SPEC) ; 151 S VALMCNT=VALMCNT+1 152 S ^TMP("IBCNBLE",$J,VALMCNT,0)=LINE 153 I $G(SPEC)="B" D CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM) 154 Q 155 ; 156 DATE(X) ; 157 N Y S Y="" I X?7N.E S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3) 158 Q Y 159 ; 160 YN(X) ; 161 N Y S X=$G(X),Y=$S(X=1:"Yes",X=0:"No",1:"") 162 Q Y 163 ; 164 ADDR(NODE,FLD) ; format address for output 165 N IBY,IB0,IBCS,IBST,IBZIP,IBJ,IBZ,IBX K ADDR S ADDR(1)="" 166 S IB0=$G(^IBA(355.33,IBBUFDA,NODE)) 167 S IBCS=$P(IB0,U,FLD+3),IBST=$P($G(^DIC(5,+$P(IB0,U,FLD+4),0)),U,2),IBZIP=$P(IB0,U,FLD+5) 168 S IBZIP=$E(IBZIP,1,5)_$S($E(IBZIP,6,9)'="":"-"_$E(IBZIP,6,9),1:"") 169 S IBST=IBST_$S(IBST=""!(IBZIP=""):"",1:" ")_IBZIP 170 S IBCS=IBCS_$S(IBCS=""!(IBST=""):"",1:", ")_IBST 171 ; 172 S IBJ=1 F IBY=$P(IB0,U,FLD),$P(IB0,U,(FLD+1)),$P(IB0,U,(FLD+2)),IBCS I IBY'="" S IBX=$G(ADDR(IBJ)),IBZ=", " D 173 . S:IBX="" IBZ="" S:($L(IBX)+2+$L(IBY))>64 IBZ="",IBJ=IBJ+1 174 . S ADDR(IBJ)=$G(ADDR(IBJ))_IBZ_IBY 175 Q 176 ; 177 TRACE(IBLINE,IBBUFDA) ; Add the eIIV Trace Number to the display 178 NEW RESP,TRACENUM,IBL,IBY 179 I '$G(IBBUFDA) G TRACEX 180 S RESP=$O(^IBCN(365,"AF",IBBUFDA,""),-1) ; response ien 181 S TRACENUM="" 182 I RESP S TRACENUM=$P($G(^IBCN(365,RESP,0)),U,9) ; trace# field 183 S IBL="eIIV Trace #: ",IBY=TRACENUM ; field label/data 184 S IBLINE=$$SETL("",IBY,IBL,18,17) ; add it 185 TRACEX ; 186 Q IBLINE 187 ;
Note:
See TracChangeset
for help on using the changeset viewer.
