- 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/IBCNSC01.m
r613 r623 1 IBCNSC01 ;ALB/NLR - INSURANCE COMPANY EDIT ;6/1/05 10:06am 2 ;;2.0;INTEGRATED BILLING;**52,137,191,184,232,320,349,371**;21-MAR-94;Build 57 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 PARAM ; -- Insurance company parameters region 6 N OFFSET,START,IBCNS0,IBCNS03,IBCNS06,IBCNS08,IBCNS13,IBCNS3 7 S IBCNS0=$G(^DIC(36,+IBCNS,0)),IBCNS3=$G(^(3)) 8 S IBCNS03=$P(IBCNS0,"^",3),IBCNS06=$P(IBCNS0,"^",6),IBCNS08=$P(IBCNS0,"^",8) 9 S IBCNS13=$G(^DIC(36,+IBCNS,.13)) 10 S START=1,OFFSET=2 11 D SET^IBCNSP(START,OFFSET+25," Billing Parameters ",IORVON,IORVOFF) 12 ; 13 D SET^IBCNSP(START+1,OFFSET+1,"Signature Required?: "_$S(+IBCNS03:"YES",1:"NO")) 14 D SET^IBCNSP(START+2,OFFSET+10,"Reimburse?: "_$E($$EXPAND^IBTRE(36,1,$P(IBCNS0,"^",2)),1,21)) 15 D SET^IBCNSP(START+3,OFFSET+3,"Mult. Bedsections: "_$S(+IBCNS06:"YES",IBCNS06=0:"NO",1:"")) 16 D SET^IBCNSP(START+4,OFFSET+4,"Diff. Rev. Codes: "_$P(IBCNS0,"^",7)) 17 D SET^IBCNSP(START+5,OFFSET+6,"One Opt. Visit: "_$S(+IBCNS08:"YES",1:"NO")) 18 D SET^IBCNSP(START+6,OFFSET+1,"Amb. Sur. Rev. Code: "_$P(IBCNS0,"^",9)) 19 D SET^IBCNSP(START+7,OFFSET+1,"Rx Refill Rev. Code: "_$P(IBCNS0,"^",15)) 20 ; 21 S OFFSET=45 22 D SET^IBCNSP(START+1,OFFSET+3,"Filing Time Frame: "_$P(IBCNS0,"^",12)) 23 D SET^IBCNSP(START+2,OFFSET+4,"Type Of Coverage: "_$$EXPAND^IBTRE(36,.13,+$P(IBCNS0,U,13))) 24 D SET^IBCNSP(START+3,OFFSET+7,"Billing Phone: "_$P(IBCNS13,"^",2)) 25 D SET^IBCNSP(START+4,OFFSET+2,"Verification Phone: "_$P(IBCNS13,"^",4)) 26 D SET^IBCNSP(START+5,OFFSET+2,"Precert Comp. Name: "_$P($G(^DIC(36,+$P(IBCNS13,"^",9),0)),"^",1)) 27 D SET^IBCNSP(START+6,OFFSET+7,"Precert Phone: "_$$PHONE(IBCNS13)) 28 I +IBCNS3=2 D SET^IBCNSP(START+7,OFFSET,"Max # Test Bills/Day: "_$P(IBCNS3,U,6)) 29 ; 30 S START=11,OFFSET=2 31 D SET^IBCNSP(START,OFFSET+28," EDI Parameters ",IORVON,IORVOFF) 32 D SET^IBCNSP(START+1,OFFSET+13,"Transmit?: "_$S(+IBCNS3=1:"YES-LIVE",+IBCNS3=2:"TEST ONLY",1:"NO")) 33 D SET^IBCNSP(START+2,OFFSET+1,"Inst Payer Primary ID: "_$P(IBCNS3,U,4)) 34 D SET^IBCNSP(START+3,OFFSET,"Inst Payer Sec ID Qual: "_$$GET1^DIQ(36,+IBCNS,6.01)) 35 D SET^IBCNSP(START+4,OFFSET+5,"Inst Payer Sec ID: "_$$GET1^DIQ(36,+IBCNS,6.02)) 36 D SET^IBCNSP(START+5,OFFSET,"Inst Payer Sec ID Qual: "_$$GET1^DIQ(36,+IBCNS,6.03)) 37 D SET^IBCNSP(START+6,OFFSET+5,"Inst Payer Sec ID: "_$$GET1^DIQ(36,+IBCNS,6.04)) 38 D SET^IBCNSP(START+7,OFFSET+12,"Bin Number: "_$P($G(^DIC(36,+IBCNS,3)),"^",3)) ; 39 ; 40 S OFFSET=41 41 D SET^IBCNSP(START+1,OFFSET+8," Insurance Type: "_$$EXPAND^IBTRE(36,3.09,+$P(IBCNS3,U,9))) 42 D SET^IBCNSP(START+2,OFFSET+1," Prof Payer Primary ID: "_$P(IBCNS3,U,2)) 43 D SET^IBCNSP(START+3,OFFSET," Prof Payer Sec ID Qual: "_$$GET1^DIQ(36,+IBCNS,6.05)) 44 D SET^IBCNSP(START+4,OFFSET+5," Prof Payer Sec ID: "_$$GET1^DIQ(36,+IBCNS,6.06)) 45 D SET^IBCNSP(START+5,OFFSET," Prof Payer Sec ID Qual: "_$$GET1^DIQ(36,+IBCNS,6.07)) 46 D SET^IBCNSP(START+6,OFFSET+5," Prof Payer Sec ID: "_$$GET1^DIQ(36,+IBCNS,6.08)) 47 Q 48 ; 49 PHONE(IBCNS13) ; -- Compute precert company phone 50 N IBX,IBSAVE,IBCNT S IBX="" 51 I '$P(IBCNS13,"^",9) S IBX=$P(IBCNS13,"^",3) G PHONEQ 52 REDOX S IBSAVE=+$P(IBCNS13,"^",9) 53 S IBCNT=$G(IBCNT)+1 54 ; -- if you process the same co. more than once you are in an infinite loop 55 I $D(IBCNT(IBCNS)) G PHONEQ 56 S IBCNT(IBCNS)="" 57 S IBCNS13=$G(^DIC(36,+$P(IBCNS13,"^",9),.13)) 58 S IBX=$P(IBCNS13,"^") S:$L($P(IBCNS13,"^",3)) IBX=$P(IBCNS13,"^",3) 59 ; -- if process the same co. more than once you are in an infinite loop 60 I $P(IBCNS13,"^",9),$P(IBCNS13,"^",9)'=IBSAVE G REDOX 61 PHONEQ Q IBX 62 ; 63 MAIN ; -- Insurance company main address 64 N OFFSET,START,IBCNS11,IBCNS13,IBADD 65 S IBCNS11=$G(^DIC(36,+IBCNS,.11)) 66 S IBCNS13=$G(^DIC(36,+IBCNS,.13)) 67 S START=21,OFFSET=25 68 D SET^IBCNSP(START,OFFSET," Main Mailing Address ",IORVON,IORVOFF) 69 N OFFSET S OFFSET=2 70 D SET^IBCNSP(START+1,OFFSET," Street: "_$P(IBCNS11,"^",1)) S IBADD=1 71 D SET^IBCNSP(START+2,OFFSET," Street 2: "_$P(IBCNS11,"^",2)) S IBADD=2 72 D SET^IBCNSP(START+3,OFFSET," Street 3: "_$P(IBCNS11,"^",3)) S IBADD=3 73 ; D SET^IBCNSP(START+4,OFFSET,"Claim Off. ID: "_$P(IBCNS11,U,11)) 74 N OFFSET S OFFSET=45 75 D SET^IBCNSP(START+1,OFFSET," City/State: "_$E($P(IBCNS11,"^",4),1,15)_$S($P(IBCNS11,"^",4)="":"",1:", ")_$P($G(^DIC(5,+$P(IBCNS11,"^",5),0)),"^",2)_" "_$E($P(IBCNS11,"^",6),1,5)) 76 D SET^IBCNSP(START+2,OFFSET," Phone: "_$P(IBCNS13,"^",1)) 77 D SET^IBCNSP(START+3,OFFSET," Fax: "_$P(IBCNS11,"^",9)) 78 Q 79 ; 80 ; 81 PAYER ; This procedure builds the display for the payer associated with 82 ; this insurance company. 83 ; ESG - 7/29/02 - IIV project 84 ; 85 NEW PAYERIEN,PAYR,APPDATA,APP,DATA,APPNAME,A1,A2,A3,A4,A5,A6,A7,A8 86 NEW START,TITLE,OFFSET,IBLINE 87 S PAYERIEN=$P($G(^DIC(36,+IBCNS,3)),U,10),PAYR="",APPDATA=0 88 I PAYERIEN D 89 . S PAYR=$G(^IBE(365.12,PAYERIEN,0)) 90 . S APP=0 91 . F S APP=$O(^IBE(365.12,PAYERIEN,1,APP)) Q:'APP D 92 .. S DATA=$G(^IBE(365.12,PAYERIEN,1,APP,0)) 93 .. S APPNAME=$$EXTERNAL^DILFD(365.121,.01,"",$P(DATA,U,1)) 94 .. I APPNAME="" Q 95 .. I $D(APPDATA(APPNAME)) Q 96 .. S (A1,A2,A3,A4,A5,A6,A7)="NO",A8="" 97 .. I $P(DATA,U,2) S A1="YES" ; national active 98 .. I $P(DATA,U,3) S A2="YES" ; local active 99 .. I $P(DATA,U,7) S A3="YES" ; auto-accept 100 .. I $P(DATA,U,8) S A4="YES" ; ident inquiries require subscr ID 101 .. I $P(DATA,U,9) S A5="YES" ; use SSN for subscriber ID 102 .. I $P(DATA,U,10) S A6="YES" ; transmit SSN 103 .. I $P(DATA,U,11) S A7="YES" ; deactivated? 104 .. ; A8 = deactivation date 105 .. I $P(DATA,U,12) S A8=$P($$FMTE^XLFDT($P(DATA,U,12),"5Z"),"@",1) 106 .. S APPDATA(APPNAME)=A1_U_A2_U_A3_U_A4_U_A5_U_A6_U_A7_U_A8 107 .. S APPDATA=APPDATA+1 108 .. Q 109 . Q 110 ; 111 S START=$O(^TMP("IBCNSC",$J,""),-1)+1 112 S IB1ST("PAYER")=START 113 S TITLE=" Payer Information/Electronic Insurance Verification " 114 S OFFSET=(40-($L(TITLE)/2))\1+1 115 D SET^IBCNSP(START,OFFSET,TITLE,IORVON,IORVOFF) 116 D SET^IBCNSP(START+1,9,"Payer Name: "_$P(PAYR,U,1)) 117 D SET^IBCNSP(START+2,5,"VA National ID: "_$P(PAYR,U,2)) 118 D SET^IBCNSP(START+2,51,"CMS National ID: "_$P(PAYR,U,3)) 119 S IBLINE=START+2 120 ; 121 ; Handle the case where no application data is defined 122 I 'APPDATA D G PAYERX 123 . S IBLINE=IBLINE+1 124 . D SET^IBCNSP(IBLINE,2," ") ; blank line 125 . S IBLINE=IBLINE+1 126 . D SET^IBCNSP(IBLINE,16,"Payer Application data is not defined!") 127 . Q 128 ; 129 ; Display all the applications 130 S APPNAME="" 131 F S APPNAME=$O(APPDATA(APPNAME)) Q:APPNAME="" D 132 . S IBLINE=IBLINE+1 133 . D SET^IBCNSP(IBLINE,2," ") ; blank line 134 . ; 135 . S IBLINE=IBLINE+1 136 . D SET^IBCNSP(IBLINE,2,"Payer Application: "_APPNAME) 137 . D SET^IBCNSP(IBLINE,50,"Auto-Accept Info: "_$P(APPDATA(APPNAME),U,3)) 138 . ; 139 . S IBLINE=IBLINE+1 140 . D SET^IBCNSP(IBLINE,4,"National Active: "_$P(APPDATA(APPNAME),U,1)) 141 . D SET^IBCNSP(IBLINE,47,"Ident Req Subscr ID: "_$P(APPDATA(APPNAME),U,4)) 142 . ; 143 . S IBLINE=IBLINE+1 144 . D SET^IBCNSP(IBLINE,7,"Local Active: "_$P(APPDATA(APPNAME),U,2)) 145 . D SET^IBCNSP(IBLINE,51,"SSN = Subscr ID: "_$P(APPDATA(APPNAME),U,5)) 146 . ; 147 . S IBLINE=IBLINE+1 148 . D SET^IBCNSP(IBLINE,8,"Deactivated: "_$P(APPDATA(APPNAME),U,7)) 149 . D SET^IBCNSP(IBLINE,54,"Transmit SSN: "_$P(APPDATA(APPNAME),U,6)) 150 . ; 151 . ; If no deactivated date, then exit 152 . I $P(APPDATA(APPNAME),U,8)="" Q 153 . ; 154 . S IBLINE=IBLINE+1 155 . D SET^IBCNSP(IBLINE,13,"D-Date: "_$P(APPDATA(APPNAME),U,8)) 156 . ; 157 . Q 158 PAYERX ; 159 ; Two trailing blank lines after payer information display 160 S IBLINE=IBLINE+1 161 D SET^IBCNSP(IBLINE,2," ") ; blank line 162 S IBLINE=IBLINE+1 163 D SET^IBCNSP(IBLINE,2," ") ; blank line 164 Q 165 ; 166 ; 167 REMARKS ; 168 ; 169 N OFFSET,START,IBLCNT,IBI 170 S START=$O(^TMP("IBCNSC",$J,""),-1)+1,OFFSET=2 171 S IB1ST("REM")=START 172 ; 173 D SET^IBCNSP(START,OFFSET," Remarks ",IORVON,IORVOFF) 174 S (IBLCNT,IBI)=0 F S IBI=$O(^DIC(36,+IBCNS,11,IBI)) Q:IBI<1 D 175 . S IBLCNT=IBLCNT+1 176 . D SET^IBCNSP(START+IBLCNT,OFFSET," "_$E($G(^DIC(36,+IBCNS,11,IBI,0)),1,80)) 177 . Q 178 D SET^IBCNSP(START+IBLCNT+1,OFFSET," ") ; blank line after remarks 179 Q 180 ; 181 SYN ; 182 N OFFSET,START,SYN,SYNOI 183 S START=$O(^TMP("IBCNSC",$J,""),-1)+1,OFFSET=2 184 S IB1ST("SYN")=START 185 D SET^IBCNSP(START,OFFSET," Synonyms ",IORVON,IORVOFF) 186 S SYN="" F SYNOI=1:1:8 S SYN=$O(^DIC(36,+IBCNS,10,"B",SYN)) Q:SYN="" D SET^IBCNSP(START+SYNOI,OFFSET,$S(SYNOI>7:" ...edit to see more...",1:" "_SYN)) 187 Q 188 ; 1 IBCNSC01 ;ALB/NLR - INSURANCE COMPANY EDIT ; 6/1/05 10:06am 2 ;;2.0;INTEGRATED BILLING;**52,137,191,184,232,320,349**;21-MAR-94;Build 46 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 PARAM ; -- Insurance company parameters region 6 N OFFSET,START,IBCNS0,IBCNS03,IBCNS06,IBCNS08,IBCNS13,IBCNS3 7 S IBCNS0=$G(^DIC(36,+IBCNS,0)),IBCNS3=$G(^(3)) 8 S IBCNS03=$P(IBCNS0,"^",3),IBCNS06=$P(IBCNS0,"^",6),IBCNS08=$P(IBCNS0,"^",8) 9 S IBCNS13=$G(^DIC(36,+IBCNS,.13)) 10 S START=1,OFFSET=2 11 D SET^IBCNSP(START,OFFSET+25," Billing Parameters ",IORVON,IORVOFF) 12 ; 13 D SET^IBCNSP(START+1,OFFSET+1,"Signature Required?: "_$S(+IBCNS03:"YES",1:"NO")) 14 D SET^IBCNSP(START+2,OFFSET+10,"Reimburse?: "_$E($$EXPAND^IBTRE(36,1,$P(IBCNS0,"^",2)),1,21)) 15 D SET^IBCNSP(START+3,OFFSET+3,"Mult. Bedsections: "_$S(+IBCNS06:"YES",IBCNS06=0:"NO",1:"")) 16 D SET^IBCNSP(START+4,OFFSET+4,"Diff. Rev. Codes: "_$P(IBCNS0,"^",7)) 17 D SET^IBCNSP(START+5,OFFSET+6,"One Opt. Visit: "_$S(+IBCNS08:"YES",1:"NO")) 18 D SET^IBCNSP(START+6,OFFSET+1,"Amb. Sur. Rev. Code: "_$P(IBCNS0,"^",9)) 19 D SET^IBCNSP(START+7,OFFSET+1,"Rx Refill Rev. Code: "_$P(IBCNS0,"^",15)) 20 D SET^IBCNSP(START+8,OFFSET+3,"Filing Time Frame: "_$P(IBCNS0,"^",12)) 21 D SET^IBCNSP(START+9,OFFSET+4,"Type Of Coverage: "_$$EXPAND^IBTRE(36,.13,+$P(IBCNS0,U,13))) 22 D SET^IBCNSP(START+10,OFFSET+3,"Primary Form Type: "_$$EXPAND^IBTRE(36,.14,$P(IBCNS0,"^",14))) 23 ; 24 N START,OFFSET 25 S START=1,OFFSET=45 26 D SET^IBCNSP(START+1,OFFSET+7,"Billing Phone: "_$P(IBCNS13,"^",2)) 27 D SET^IBCNSP(START+2,OFFSET+2,"Verification Phone: "_$P(IBCNS13,"^",4)) 28 D SET^IBCNSP(START+3,OFFSET+2,"Precert Comp. Name: "_$P($G(^DIC(36,+$P(IBCNS13,"^",9),0)),"^",1)) 29 D SET^IBCNSP(START+4,OFFSET+7,"Precert Phone: "_$$PHONE(IBCNS13)) 30 D SET^IBCNSP(START+5,OFFSET+6," *** EDI Parameters *** ",IOINHI,IOINORM) 31 D SET^IBCNSP(START+6,OFFSET+11,"Transmit?: "_$S(+IBCNS3=1:"YES-LIVE",+IBCNS3=2:"TEST ONLY",1:"NO")) 32 D SET^IBCNSP(START+7,OFFSET+7,"Inst Payer ID: "_$P(IBCNS3,U,4)) 33 D SET^IBCNSP(START+8,OFFSET+7,"Prof Payer ID: "_$P(IBCNS3,U,2)) 34 D SET^IBCNSP(START+9,OFFSET+6,"Insurance Type: "_$$EXPAND^IBTRE(36,3.09,+$P(IBCNS3,U,9))) 35 D SET^IBCNSP(START+10,OFFSET+10,"Bin Number: "_$P($G(^DIC(36,+IBCNS,3)),"^",3)) 36 I +IBCNS3=2 D SET^IBCNSP(START+11,OFFSET,"Max # Test Bills/Day: "_$P(IBCNS3,U,6)) 37 Q 38 ; 39 PHONE(IBCNS13) ; -- Compute precert company phone 40 N IBX,IBSAVE,IBCNT S IBX="" 41 I '$P(IBCNS13,"^",9) S IBX=$P(IBCNS13,"^",3) G PHONEQ 42 REDOX S IBSAVE=+$P(IBCNS13,"^",9) 43 S IBCNT=$G(IBCNT)+1 44 ; -- if you process the same co. more than once you are in an infinite loop 45 I $D(IBCNT(IBCNS)) G PHONEQ 46 S IBCNT(IBCNS)="" 47 S IBCNS13=$G(^DIC(36,+$P(IBCNS13,"^",9),.13)) 48 S IBX=$P(IBCNS13,"^") S:$L($P(IBCNS13,"^",3)) IBX=$P(IBCNS13,"^",3) 49 ; -- if process the same co. more than once you are in an infinite loop 50 I $P(IBCNS13,"^",9),$P(IBCNS13,"^",9)'=IBSAVE G REDOX 51 PHONEQ Q IBX 52 ; 53 MAIN ; -- Insurance company main address 54 N OFFSET,START,IBCNS11,IBCNS13,IBADD 55 S IBCNS11=$G(^DIC(36,+IBCNS,.11)) 56 S IBCNS13=$G(^DIC(36,+IBCNS,.13)) 57 S START=15,OFFSET=25 58 D SET^IBCNSP(START,OFFSET," Main Mailing Address ",IORVON,IORVOFF) 59 N OFFSET S OFFSET=2 60 D SET^IBCNSP(START+1,OFFSET," Street: "_$P(IBCNS11,"^",1)) S IBADD=1 61 D SET^IBCNSP(START+2,OFFSET," Street 2: "_$P(IBCNS11,"^",2)) S IBADD=2 62 D SET^IBCNSP(START+3,OFFSET," Street 3: "_$P(IBCNS11,"^",3)) S IBADD=3 63 ; D SET^IBCNSP(START+4,OFFSET,"Claim Off. ID: "_$P(IBCNS11,U,11)) 64 N OFFSET S OFFSET=45 65 D SET^IBCNSP(START+1,OFFSET," City/State: "_$E($P(IBCNS11,"^",4),1,15)_$S($P(IBCNS11,"^",4)="":"",1:", ")_$P($G(^DIC(5,+$P(IBCNS11,"^",5),0)),"^",2)_" "_$E($P(IBCNS11,"^",6),1,5)) 66 D SET^IBCNSP(START+2,OFFSET," Phone: "_$P(IBCNS13,"^",1)) 67 D SET^IBCNSP(START+3,OFFSET," Fax: "_$P(IBCNS11,"^",9)) 68 Q 69 ; 70 ; 71 PAYER ; This procedure builds the display for the payer associated with 72 ; this insurance company. 73 ; ESG - 7/29/02 - IIV project 74 ; 75 NEW PAYERIEN,PAYR,APPDATA,APP,DATA,APPNAME,A1,A2,A3,A4,A5,A6,A7,A8 76 NEW START,TITLE,OFFSET,IBLINE 77 S PAYERIEN=$P($G(^DIC(36,+IBCNS,3)),U,10),PAYR="",APPDATA=0 78 I PAYERIEN D 79 . S PAYR=$G(^IBE(365.12,PAYERIEN,0)) 80 . S APP=0 81 . F S APP=$O(^IBE(365.12,PAYERIEN,1,APP)) Q:'APP D 82 .. S DATA=$G(^IBE(365.12,PAYERIEN,1,APP,0)) 83 .. S APPNAME=$$EXTERNAL^DILFD(365.121,.01,"",$P(DATA,U,1)) 84 .. I APPNAME="" Q 85 .. I $D(APPDATA(APPNAME)) Q 86 .. S (A1,A2,A3,A4,A5,A6,A7)="NO",A8="" 87 .. I $P(DATA,U,2) S A1="YES" ; national active 88 .. I $P(DATA,U,3) S A2="YES" ; local active 89 .. I $P(DATA,U,7) S A3="YES" ; auto-accept 90 .. I $P(DATA,U,8) S A4="YES" ; ident inquiries require subscr ID 91 .. I $P(DATA,U,9) S A5="YES" ; use SSN for subscriber ID 92 .. I $P(DATA,U,10) S A6="YES" ; transmit SSN 93 .. I $P(DATA,U,11) S A7="YES" ; deactivated? 94 .. ; A8 = deactivation date 95 .. I $P(DATA,U,12) S A8=$P($$FMTE^XLFDT($P(DATA,U,12),"5Z"),"@",1) 96 .. S APPDATA(APPNAME)=A1_U_A2_U_A3_U_A4_U_A5_U_A6_U_A7_U_A8 97 .. S APPDATA=APPDATA+1 98 .. Q 99 . Q 100 ; 101 S START=$O(^TMP("IBCNSC",$J,""),-1)+1 102 S IB1ST("PAYER")=START 103 S TITLE=" Payer Information/Electronic Insurance Verification " 104 S OFFSET=(40-($L(TITLE)/2))\1+1 105 D SET^IBCNSP(START,OFFSET,TITLE,IORVON,IORVOFF) 106 D SET^IBCNSP(START+1,9,"Payer Name: "_$P(PAYR,U,1)) 107 D SET^IBCNSP(START+2,5,"VA National ID: "_$P(PAYR,U,2)) 108 D SET^IBCNSP(START+2,51,"CMS National ID: "_$P(PAYR,U,3)) 109 S IBLINE=START+2 110 ; 111 ; Handle the case where no application data is defined 112 I 'APPDATA D G PAYERX 113 . S IBLINE=IBLINE+1 114 . D SET^IBCNSP(IBLINE,2," ") ; blank line 115 . S IBLINE=IBLINE+1 116 . D SET^IBCNSP(IBLINE,16,"Payer Application data is not defined!") 117 . Q 118 ; 119 ; Display all the applications 120 S APPNAME="" 121 F S APPNAME=$O(APPDATA(APPNAME)) Q:APPNAME="" D 122 . S IBLINE=IBLINE+1 123 . D SET^IBCNSP(IBLINE,2," ") ; blank line 124 . ; 125 . S IBLINE=IBLINE+1 126 . D SET^IBCNSP(IBLINE,2,"Payer Application: "_APPNAME) 127 . D SET^IBCNSP(IBLINE,50,"Auto-Accept Info: "_$P(APPDATA(APPNAME),U,3)) 128 . ; 129 . S IBLINE=IBLINE+1 130 . D SET^IBCNSP(IBLINE,4,"National Active: "_$P(APPDATA(APPNAME),U,1)) 131 . D SET^IBCNSP(IBLINE,47,"Ident Req Subscr ID: "_$P(APPDATA(APPNAME),U,4)) 132 . ; 133 . S IBLINE=IBLINE+1 134 . D SET^IBCNSP(IBLINE,7,"Local Active: "_$P(APPDATA(APPNAME),U,2)) 135 . D SET^IBCNSP(IBLINE,51,"SSN = Subscr ID: "_$P(APPDATA(APPNAME),U,5)) 136 . ; 137 . S IBLINE=IBLINE+1 138 . D SET^IBCNSP(IBLINE,8,"Deactivated: "_$P(APPDATA(APPNAME),U,7)) 139 . D SET^IBCNSP(IBLINE,54,"Transmit SSN: "_$P(APPDATA(APPNAME),U,6)) 140 . ; 141 . ; If no deactivated date, then exit 142 . I $P(APPDATA(APPNAME),U,8)="" Q 143 . ; 144 . S IBLINE=IBLINE+1 145 . D SET^IBCNSP(IBLINE,13,"D-Date: "_$P(APPDATA(APPNAME),U,8)) 146 . ; 147 . Q 148 PAYERX ; 149 ; Two trailing blank lines after payer information display 150 S IBLINE=IBLINE+1 151 D SET^IBCNSP(IBLINE,2," ") ; blank line 152 S IBLINE=IBLINE+1 153 D SET^IBCNSP(IBLINE,2," ") ; blank line 154 Q 155 ; 156 ; 157 REMARKS ; 158 ; 159 N OFFSET,START,IBLCNT,IBI 160 S START=$O(^TMP("IBCNSC",$J,""),-1)+1,OFFSET=2 161 S IB1ST("REM")=START 162 ; 163 D SET^IBCNSP(START,OFFSET," Remarks ",IORVON,IORVOFF) 164 S (IBLCNT,IBI)=0 F S IBI=$O(^DIC(36,+IBCNS,11,IBI)) Q:IBI<1 D 165 . S IBLCNT=IBLCNT+1 166 . D SET^IBCNSP(START+IBLCNT,OFFSET," "_$E($G(^DIC(36,+IBCNS,11,IBI,0)),1,80)) 167 . Q 168 D SET^IBCNSP(START+IBLCNT+1,OFFSET," ") ; blank line after remarks 169 Q 170 ; 171 SYN ; 172 N OFFSET,START,SYN,SYNOI 173 S START=$O(^TMP("IBCNSC",$J,""),-1)+1,OFFSET=2 174 S IB1ST("SYN")=START 175 D SET^IBCNSP(START,OFFSET," Synonyms ",IORVON,IORVOFF) 176 S SYN="" F SYNOI=1:1:8 S SYN=$O(^DIC(36,+IBCNS,10,"B",SYN)) Q:SYN="" D SET^IBCNSP(START+SYNOI,OFFSET,$S(SYNOI>7:" ...edit to see more...",1:" "_SYN)) 177 Q 178 ;
Note:
See TracChangeset
for help on using the changeset viewer.
