| 1 | IBCEP9B ;ALB/TMP - UPDATE OF PROVIDER ID FROM FILE UTILITIES ;14-NOV-00
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**137,200,320**;21-MAR-94
|
|---|
| 3 | ;
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | READFILE ; Read records stored in ^TMP($J
|
|---|
| 7 | ;
|
|---|
| 8 | N D,DA,DIC,IBCT,IBP,IBQUIT,IBS,IBX,P,P3,X,Y,Z
|
|---|
| 9 | S (IBCT,IBQUIT,IBQUIT1,IBS)=0
|
|---|
| 10 | U IO(0)
|
|---|
| 11 | ;
|
|---|
| 12 | F S IBCT=$O(^TMP($J,IBCT)) Q:'IBCT S X=$G(^(IBCT)) I X'="" D Q:IBQUIT
|
|---|
| 13 | . D Q:IBQUIT
|
|---|
| 14 | .. I $P($G(IBPOS),U)="D" D
|
|---|
| 15 | ... D CSV(X,.IBX,$P(IBPOS,U,2),$P(IBPOS,U,3))
|
|---|
| 16 | ... D DSETUP(.IBX,.IBPOS,.P) K IBX
|
|---|
| 17 | .. I $P($G(IBPOS),U)'="D" D FSETUP(X,.IBPOS,.P)
|
|---|
| 18 | . ;
|
|---|
| 19 | . I $G(P(1))'="" S P(1)=$$NOPUNCT^IBCEF(P(1),1),X=P(1),D="SSN",DIC="^VA(200,",DIC(0)="" D IX^DIC
|
|---|
| 20 | . S IBP=+Y,IBVNAME=$P(Y,U,2)
|
|---|
| 21 | . I $S($G(P(1))="":1,1:Y'>0) D Q
|
|---|
| 22 | .. S ^TMP("IBPID-ERR",$J,1,$S($G(P(1))'="":P(1),1:"NO SSN"),$G(P(2))_" ","??")=""
|
|---|
| 23 | .. N IBID
|
|---|
| 24 | .. S IBID=$S(IBFT=0!(IBFT=1):$G(P("INST_ID")),1:$G(P("PROF_ID")))
|
|---|
| 25 | .. S ^TMP("IBPID-ERR",$J,1,$S($G(P(1))'="":P(1),1:"NO SSN"),$G(P(2))_" ","PROV ID")=IBID
|
|---|
| 26 | . ;
|
|---|
| 27 | . S ^TMP("IBPID_IN",$J,U,IBP)=P(1)_U_P(2)_U_IBVNAME
|
|---|
| 28 | . F Q0=0,"TID","UPIN","INST_ID","PROF_ID","CU","CRED" S ^TMP("IBPID_IN",$J,U,IBP,Q0)=$G(P(Q0))
|
|---|
| 29 | Q
|
|---|
| 30 | ;
|
|---|
| 31 | CSV(X,IBX,IBDEL,IBQUOTES) ; Parse out fields from a delimited file
|
|---|
| 32 | ; X = data string in CSV format to be parsed
|
|---|
| 33 | ; IBX = array returned if passed by reference, subscripted by field #
|
|---|
| 34 | ; IBDEL = the delimiter
|
|---|
| 35 | ; If IBQUOTES=1, quoted strings are double quoted within a field
|
|---|
| 36 | N FC,I,PC,QCT,QM,QM2,QM4,STR,TPC
|
|---|
| 37 | S FC=0,TPC=$L(X,IBDEL),QM=$C(34),QM2=QM_QM,QM4=QM2_QM2
|
|---|
| 38 | F PC=1:1:TPC D
|
|---|
| 39 | . S STR=$P(X,IBDEL,PC)
|
|---|
| 40 | . S FC=FC+1
|
|---|
| 41 | . I (STR=QM2)!(STR=QM4) S IBX(FC)="" Q
|
|---|
| 42 | . I $E(STR,1)=QM D
|
|---|
| 43 | .. F QCT=0:1 Q:$E(STR,QCT+1)'=QM
|
|---|
| 44 | .. F Q:($E(STR,1,QCT)=$E(STR,$L(STR)-(QCT-1),$L(STR))) S PC=PC+1 Q:PC>TPC S STR=STR_IBDEL_$P(X,IBDEL,PC)
|
|---|
| 45 | .. I PC>TPC S IBX(0)="-1^UNMATCHED QUOTE MARKS" Q
|
|---|
| 46 | .. F Q:$E(STR,1)'=QM I $E(STR,$L(STR))=QM S STR=$E(STR,2,$L(STR)-1)
|
|---|
| 47 | . I IBQUOTES,STR[QM2 D
|
|---|
| 48 | .. F I=1:1:$L(STR) I $E(STR,I,I+1)=QM2 S STR=$E(STR,1,I)_$E(STR,I+2,9999)
|
|---|
| 49 | . S IBX(FC)=STR
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | MANUAL ; Manual entry to get providers from VistA
|
|---|
| 53 | N IBCRED,IBDA,IBNAM,IBSSN
|
|---|
| 54 | ; S IBCNT=0 ; this looks like extraneous code, IBCNT not used anywhere.
|
|---|
| 55 | F D I X=""!(X["^") Q
|
|---|
| 56 | . S Y=$$LOOKUP^XUSER Q:X="" I X["^" S IBQUIT1=1 Q
|
|---|
| 57 | . S IBDA=+Y,IBNAM=$P(Y,U,2)
|
|---|
| 58 | . S IBSSN=$$GET1^DIQ(200,IBDA_",",9,"I")
|
|---|
| 59 | . S IBCRED=$$GET1^DIQ(200,IBDA_",",10.6,"I")
|
|---|
| 60 | . S ^TMP("IBPID_IN",$J,U,IBDA)=IBSSN_U_IBNAM_" "_IBCRED
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | DIR1(DIR,Z,IBQUIT,IBQUIT1) ; Ask position
|
|---|
| 64 | N X,Y
|
|---|
| 65 | S Y=$$DIR^IBCEP9(.DIR,.IBQUIT,.IBQUIT1)
|
|---|
| 66 | I IBQUIT1 S Y="" G DIRQ
|
|---|
| 67 | I $P(Z,U,4),Y'>0 S Y="",(IBQUIT1,IBQUIT)=1
|
|---|
| 68 | I Y'>0 S Y=""
|
|---|
| 69 | DIRQ Q Y
|
|---|
| 70 | ;
|
|---|
| 71 | DISP(Q,IBID,IBINS,IBPTYP,IBFT,IBCT,IBCU,IBPID,IBSRC) ; Display provider data
|
|---|
| 72 | ; includes ID data if IBID=1
|
|---|
| 73 | ; Q = SSN^provider name from input^provider name from file #200
|
|---|
| 74 | ; IBPID = array of id numbers to be stored
|
|---|
| 75 | N A,IBL,Q0,Z
|
|---|
| 76 | S $P(Q,U,2)=$$FLEN($P(Q,U,2))
|
|---|
| 77 | S Q0(1)="PROVIDER : "_$P(Q,U)_$S($P(Q,U,2)'="":" ("_$P(Q,U,2)_")",1:"")_$S(IBSRC="F":" <- input file data",1:"")
|
|---|
| 78 | S Q0(2)="" S:IBSRC="F" Q0(2)=$J("("_$P(Q,U,3),22+$L($P(Q,U,3)))_") <- VA match"
|
|---|
| 79 | S IBL=0
|
|---|
| 80 | D DISP^IBCEP4("Q0",IBINS,IBPTYP,IBFT,IBCT,3,.IBL)
|
|---|
| 81 | I $G(IBCU)'="" S Q0(IBL+1)="CARE UNIT: "_IBCU
|
|---|
| 82 | W !
|
|---|
| 83 | S A=0 F S A=$O(Q0(A)) Q:'A W !,Q0(A)
|
|---|
| 84 | I $G(IBID),$O(IBPID(""))'="" D ; Display id's to be filed
|
|---|
| 85 | . W ! S Z="" F S Z=$O(IBPID(Z)) Q:Z="" I IBPID(Z)'="" D
|
|---|
| 86 | .. W !,$S(Z="TID":"TAX ID NUMBER",Z="INST_ID":"INSTITUTIONAL ID",Z="PROF_ID":"PROFESSIONAL ID",Z="UPIN":"UPIN",1:"PROV ID"),": ",IBPID(Z)
|
|---|
| 87 | Q
|
|---|
| 88 | ;
|
|---|
| 89 | DSETUP(IBX,IBPOS,P) ; Set up the subscripted array P with the correct data
|
|---|
| 90 | ; from IBX(pc #) based on the parameters in array IBPOS
|
|---|
| 91 | ; RETURNED: P(data index)=data value (pass by reference)
|
|---|
| 92 | N Q,Z,Z0
|
|---|
| 93 | S Z=$G(IBPOS("SSN")),P(1)=""
|
|---|
| 94 | F Z0=+Z:1:$S('$P(Z,U,2):Z,1:$P(Z,U,2)) S P(1)=P(1)_$S(P(1)'=""&($G(IBX(Z0))'=""):" ",1:"")_$G(IBX(Z0))
|
|---|
| 95 | S Z=$G(IBPOS("NAM")),P(2)=""
|
|---|
| 96 | F Z0=+Z:1:$S('$P(Z,U,2):Z,1:$P(Z,U,2)) S P(2)=P(2)_$S(P(2)'=""&($G(IBX(Z0))'=""):" ",1:"")_$G(IBX(Z0))
|
|---|
| 97 | F Q="TID","UPIN","INST_ID","PROF_ID","CRED","CU","LIC" D
|
|---|
| 98 | . S Z=$G(IBPOS(Q)),P(Q)=""
|
|---|
| 99 | . Q:'Z
|
|---|
| 100 | . F Z0=+Z:1:$S('$P(Z,U,2):Z,1:$P(Z,U,2)) S P(Q)=P(Q)_$S(P(Q)'=""&($G(IBX(Z0))'=""):" ",1:"")_$G(IBX(Z0))
|
|---|
| 101 | Q
|
|---|
| 102 | ;
|
|---|
| 103 | FSETUP(X,IBPOS,P) ;Set up the subscripted array P with the correct data
|
|---|
| 104 | ; from record data in X, based on the parameters in array IBPOS for a
|
|---|
| 105 | ; fixed length data field format
|
|---|
| 106 | ; RETURNED: P(data index)=data value (pass by reference)
|
|---|
| 107 | ;
|
|---|
| 108 | N Q,Z
|
|---|
| 109 | S Z=$G(IBPOS("SSN")),P(1)=""
|
|---|
| 110 | S P(1)=$E(X,+Z,$S($P(Z,U,2):$P(Z,U,2),1:+Z))
|
|---|
| 111 | S Z=$G(IBPOS("NAM")),P(2)=""
|
|---|
| 112 | S P(2)=$E(X,+Z,$S($P(Z,U,2):$P(Z,U,2),1:+Z))
|
|---|
| 113 | F Q="TID","UPIN","INST_ID","PROF_ID","CRED","CU","LIC" D
|
|---|
| 114 | . S Z=$G(IBPOS(Q)),P(Q)=""
|
|---|
| 115 | . Q:'Z
|
|---|
| 116 | . S P(Q)=$$FLEN($E(X,+Z,$S($P(Z,U,2):$P(Z,U,2),1:+Z)))
|
|---|
| 117 | Q
|
|---|
| 118 | ;
|
|---|
| 119 | FLEN(IBX) ; Strip out trailing spaces from field
|
|---|
| 120 | ; FUNCTION returns stripped data
|
|---|
| 121 | N Z,IB,IB1
|
|---|
| 122 | S IB1=IBX,IB=$TR(IB1," ")
|
|---|
| 123 | I IB'="" F Z=$L(IB1):-1:1 I $E(IB1,Z)'=" " S IB=$E(IB1,1,Z) Q
|
|---|
| 124 | Q IB
|
|---|
| 125 | ;
|
|---|
| 126 | ADDID(IB200,IBINS,IBCU,IBFT,IBCT,IBPTYP,IBQUIT,IBQUIT1) ; Add ID record (file 355.9) if not already there
|
|---|
| 127 | N DIC,X,Y,DO,DD,DLAYGO,DIR
|
|---|
| 128 | S X=IB200_";VA(200,"
|
|---|
| 129 | S Y=+$O(^IBA(355.9,"AUNIQ",X,$S(IBINS:IBINS,1:"*ALL*"),$S($G(IBCU)'="":IBCU,1:"*N/A*"),IBFT,IBCT,IBPTYP,0))
|
|---|
| 130 | I 'Y D
|
|---|
| 131 | . S DIC(0)="L",DIC="^IBA(355.9,",DLAYGO=355.9,DIC("DR")=".02////"_IBINS_$S($G(IBCU)'="":";.03////"_IBCU,1:"")_";.04////"_IBFT_";.05////"_IBCT_";.06////"_IBPTYP
|
|---|
| 132 | . D FILE^DICN K DIC,DO,DD,DLAYGO
|
|---|
| 133 | I Y'>0 D Q
|
|---|
| 134 | . S DIR(0)="AE",DIR("A",1)="A PROBLEM WAS ENCOUNTERED ADDING THIS PROVIDER ID RECORD - NO RECORD ADDED",DIR("A")="PRESS ENTER TO CONTINUE "
|
|---|
| 135 | . S Y=$$DIR^IBCEP9(.DIR,.IBQUIT,.IBQUIT1,,1,1)
|
|---|
| 136 | S IBN=Y
|
|---|
| 137 | Q $S(IBN>0:IBN,1:0)
|
|---|
| 138 | ;
|
|---|
| 139 | PRTERR ; Prints error report
|
|---|
| 140 | N IBPAGE,Z,Z0,Z1,Z2,Z3,IBLCT,IBSTOP,IBHDT
|
|---|
| 141 | W:$E(IOST,1,2)["C-" @IOF
|
|---|
| 142 | I $D(^TMP("IBPID-ERR",$J)) D
|
|---|
| 143 | . S IBSTOP=0,IBLCT=$$HDR(.IBPAGE,.IBSTOP,.IBHDT)
|
|---|
| 144 | . S Z=0 F S Z=$O(^TMP("IBPID-ERR",$J,Z)) Q:'Z W !!,$P($T(ERR+Z^IBCEP9),";;",2)_":" D
|
|---|
| 145 | .. S Z0=""
|
|---|
| 146 | .. F S Z0=$O(^TMP("IBPID-ERR",$J,Z,Z0)) Q:Z0="" S IBLCT=IBLCT+1 S:(IBLCT+5)>IOSL IBLCT=$$HDR(.IBPAGE,.IBSTOP) Q:IBSTOP D
|
|---|
| 147 | ... S Z1="" F S Z1=$O(^TMP("IBPID-ERR",$J,Z,Z0,Z1)) Q:Z1="" W !,$E(Z0_$J("",9),1,9) W:$P(Z1,U)'="" " "_$E($P(Z1,U)_$J("",40),1,40) D
|
|---|
| 148 | .... S Z2="" F S Z2=$O(^TMP("IBPID-ERR",$J,Z,Z0,Z1,Z2)) Q:Z2="" S Z3=$G(^(Z2)) I Z3'="" D
|
|---|
| 149 | ..... W " "_$S(Z2="CU":"CARE UNIT",Z2="CRED":"CREDENTIALS",Z2="TID":"TAX ID #",Z2="LIC_ST":"LICENSE STATE",Z2="LIC":"LICENSE",Z2="UPIN":"UPIN",1:Z2)_": "_Z3
|
|---|
| 150 | FILED ; Prints all filed records
|
|---|
| 151 | I $D(^TMP("IBPID_IN",$J)) D
|
|---|
| 152 | . S IBSTOP=0,IBLCT=$$HDR(.IBPAGE,.IBSTOP,.IBHDT)
|
|---|
| 153 | . W !!," RECORDS SELECTED FOR FILING:"
|
|---|
| 154 | . S Z0=""
|
|---|
| 155 | . F S Z0=$O(^TMP("IBPID_IN",$J,U,Z0)) Q:Z0="" S IBLCT=IBLCT+1 S:(IBLCT+5)>IOSL IBLCT=$$HDR(.IBPAGE,.IBSTOP) Q:IBSTOP D
|
|---|
| 156 | .. I $G(^TMP("IBPID_IN",$J,U,Z0,0))="NO PRINT" S:IBLCT>6 IBLCT=IBLCT-1 Q
|
|---|
| 157 | .. S Z=^TMP("IBPID_IN",$J,U,Z0)
|
|---|
| 158 | .. W !,$P(Z,U,1),?12,$P(Z,U,2),?52,$G(^TMP("IBPID_IN",$J,U,Z0,"INST_ID"))
|
|---|
| 159 | ;
|
|---|
| 160 | I $E(IOST,1,2)["C-",'IBSTOP K DIR S DIR(0)="E" D ^DIR K DIR
|
|---|
| 161 | W @IOF
|
|---|
| 162 | I $D(ZTQUEUED) S ZTREQ="@"
|
|---|
| 163 | I '$D(ZTQUEUED) W ! D ^%ZISC
|
|---|
| 164 | Q
|
|---|
| 165 | HDR(PG,IBSTOP,IBHDT) ; Prints error report header, function returns # of lines used
|
|---|
| 166 | ; PG = the last page # printed
|
|---|
| 167 | ; IBHDT = the run date of the report
|
|---|
| 168 | N Z,IBLCT
|
|---|
| 169 | S IBLCT=0
|
|---|
| 170 | I '$G(PG) S IBHDT="RUN DATE: "_$$FMTE^XLFDT($$NOW^XLFDT(),2)_U_"RUN BY: "_$P($G(^VA(200,+$G(IBDUZ),0)),U)
|
|---|
| 171 | I $G(PG),$E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR S IBSTOP=('Y) G:IBSTOP HDRQ W @IOF
|
|---|
| 172 | S PG=$G(PG)+1
|
|---|
| 173 | W $J("",23)_"BATCH UPDATE OF PROVIDER ID REPORT"_$J("",13)_"PAGE: ",PG
|
|---|
| 174 | W !,$J("",(80-$L($P($G(IBHDT),U)))\2),$P($G(IBHDT),U)
|
|---|
| 175 | W !,$J("",(80-$L($P($G(IBHDT),U,2)))\2),$P($G(IBHDT),U,2)
|
|---|
| 176 | W !!," INSURANCE CO: "_$P($G(^DIC(36,+$G(IBINS),0)),U)
|
|---|
| 177 | W !,"PROVIDER ID TYPE: "_$P($G(^IBE(355.97,+$G(IBPTYP),0)),U)
|
|---|
| 178 | W !," FORM TYPE: "_$$EXPAND^IBTRE(355.91,.04,$G(IBFT))
|
|---|
| 179 | W !," CARE TYPE: "_$$EXPAND^IBTRE(355.91,.05,$G(IBCT))
|
|---|
| 180 | S IBLCT=7
|
|---|
| 181 | I $G(IBCU)'="" W !,$J("",7)_"CARE UNIT: "_IBCU S IBLCT=IBLCT+1
|
|---|
| 182 | S Z="",$P(Z,"=",81)="",IBLCT=IBLCT+1
|
|---|
| 183 | W !,Z
|
|---|
| 184 | HDRQ Q $G(IBLCT)
|
|---|
| 185 | ;
|
|---|
| 186 | LOCK(IBINS) ; Lock Parent and Children up
|
|---|
| 187 | N IBQUIT
|
|---|
| 188 | S IBQUIT=0
|
|---|
| 189 | I $P($G(^DIC(36,IBINS,3)),U,13)="P" D
|
|---|
| 190 | . L +^DIC(36,IBINS):5 E S IBQUIT=1 Q
|
|---|
| 191 | . N CHILD
|
|---|
| 192 | . S CHILD="" F S CHILD=$O(^DIC(36,"APC",IBINS,CHILD)) Q:'+CHILD D Q:IBQUIT
|
|---|
| 193 | .. L +^DIC(36,CHILD):5 E S IBQUIT=1
|
|---|
| 194 | Q IBQUIT
|
|---|
| 195 | ;
|
|---|
| 196 | UNLOCK(IBINS) ; Unlock the family
|
|---|
| 197 | I $P($G(^DIC(36,IBINS,3)),U,13)="P" D
|
|---|
| 198 | . L -^DIC(36,IBINS)
|
|---|
| 199 | . N CHILD
|
|---|
| 200 | . S CHILD="" F S CHILD=$O(^DIC(36,"APC",IBINS,CHILD)) Q:'+CHILD D
|
|---|
| 201 | .. L -^DIC(36,CHILD)
|
|---|
| 202 | Q
|
|---|
| 203 | ;
|
|---|
