238 lines
9.5 KiB
Mathematica
238 lines
9.5 KiB
Mathematica
DVBHQD1 ;ISC-ALBANY/PKE/PHH- HINQ receiver ; 5/15/06 10:58am
|
|
;;4.0;HINQ;**3,12,16,22,23,32,34,40,46,49,57,56**; 03/25/92
|
|
;
|
|
S:'$D(DTIME) DTIME=300 S DVBTIME=DTIME
|
|
EN S:$G(IO(0))="" IO(0)=$I S (C,DVBTSK,DVBABORT)=0,DVBXM=1,DTIME=30 U IO(0)
|
|
;
|
|
SEL S (DVBRTC,DVBTRY)=1,DVBNRT="Y"
|
|
R !!," Select Input: (P)atient File, or (D)irect P//",X:DTIME I '$T!(X["^") G HINQ
|
|
I "Pp"[$E(X) S DVBPRGM="TM^DVBHIQD" G ASK
|
|
I "Dd"[$E(X_1) S DVBPRGM="EN^DVBHQDE" G ASK
|
|
I X["?" D HP^DVBHQAT G SEL
|
|
G SEL
|
|
ASK S:$G(IO(0))="" IO(0)=$I W ! S Y=0,DVBIO=IO D @DVBPRGM
|
|
ASK1 I Y'<0,$D(DVBP),$L(DVBP)=4 S IO=DVBIO D STUFF^DVBHQAT:$D(DFN),MES
|
|
I $D(DVBMISS) K DVBMISS D:DVBTRY>3 RETRY^DVBHQD2 G:DVBNRT="N" LOAD2^DVBHQD2 I DVBTRY<4&(DVBRTC<4) S DVBTRY=DVBTRY+1 U IO(0) W ?35,"Retrying Request." G ASK1
|
|
S IO=DVBIO U IO(0) K DVBP S DVBABORT=0
|
|
I '$D(Y) G ASK
|
|
I Y>0 G ASK
|
|
;
|
|
HINQ U IO(0) W !!,"Do you wish to continue" S %=2 D YN^DICN G:'% HINQ I %=1 W ! G EN
|
|
EX S DTIME=$S($D(DVBTIME):DVBTIME,1:300)
|
|
Q
|
|
MES ;
|
|
S:$G(IO(0))="" IO(0)=$I S E=$L(DVBZ) I '$D(DVBDXX),($E(DVBZ,E-7,E-4)'=DVBNUM) S DVBZ=$E(DVBZ,1,E-4)_DVBNUM_$E(DVBZ,E-3,999)
|
|
K E H 1 S DVBEND="NNNN" S:'$D(DVBXM) DVBXM=0 S:'$D(C) C=0
|
|
;
|
|
TOTIMS S TRY=0,CN=$F(DVBZ,"/CN",24),DVBZ0=DVBZ
|
|
I $S('$D(DFN):1,DFN:0,1:1) S CN=0 D SEND^DVBHQD2,KTO^DVBHQD2 Q
|
|
I 'CN D CNLKUP^DVBHQAT
|
|
DO D SEND^DVBHQD2 I TRY DO I TRY H 1 D SEND^DVBHQD2
|
|
.I CN,'TRY S DVBZ0=$E(DVBZ,1,23)_$E(DVBZ,24,CN-3)_$E(DVBZ,CN+9,999) Q
|
|
.I CN,TRY S DVBZ1=$E(DVBZ,1,23)_$E(DVBZ,CN-2,999) Q
|
|
.I 'CN S DVBZ0=DVBZ,TRY=0 Q
|
|
I $D(DVBMISS)&($D(DVBPRGM)) I (DVBPRGM["TM") K DVBMISS D:DVBTRY>3 RETRY^DVBHQD2 G:DVBNRT="N" LOAD^DVBHQD2 I DVBTRY<4&(DVBRTC<4) S DVBTRY=DVBTRY+1 U IO(0) W ?35,"Retrying Request." G MES
|
|
G KTO^DVBHQD2
|
|
;
|
|
;z1 is first x(),z9 is last x()
|
|
OK ;I 'DVBTSK DO
|
|
;. U IO(0) W !!?3 S Z1=0 F S Z1=$O(X(Z1)) Q:'Z1 S LX=$G(LX)+$L(X(Z1)) W Z1," ",$L(X(Z1))," "
|
|
;. W !?9,LX,! K LX H 3 U IO
|
|
S:$G(IO(0))="" IO(0)=$I S Z1=$O(X(0)) F Q:$E(X(Z1))'=$C(10) S X(Z1)=$E(X(Z1),2,999)
|
|
I $G(X(Z1))["HINQ" S X(Z1)="HINQ"_$P(X(Z1),"HINQ",2)
|
|
E K X(Z1) DO
|
|
. S Z1=$O(X(0)) I Z1="" S Z1=0,X(0)=""
|
|
. I $G(X(Z1))["HINQ" S X(Z1)="HINQ"_$P(X(Z1),"HINQ",2)
|
|
I $L(X(Z1))>25 S DVBLEN=+$E(X(Z1),22,25)
|
|
I $L(X(Z1))'>25 D
|
|
. I $D(X(Z1+1)) DO
|
|
. . S DVBLEN=+$E($E(X(Z1),1,99)_$E(X(Z1+1),1,30),22,25)
|
|
. I '$D(X(Z1+1)) D
|
|
. . S DVBLEN=$L(X(Z1)) ;DVB*4*49 - error response may be < 25 chars
|
|
I '$D(DVBLEN) S DVBABORT=DVBABORT+1 U IO(0) W:'DVBTSK !,"Missing string" U IO Q
|
|
;
|
|
I $D(F3) S DVBLEN=DVBLEN-F3 K F3
|
|
I "456789ABCDUVWNMXYZ"'[$E(X(Z1),5) S DVBLEN=DVBLEN-2
|
|
;
|
|
S (Z,Z9,F2)=0 F S Z=$O(X(Z)) Q:'Z S Z9=Z,F2=F2+$L(X(Z))
|
|
;
|
|
I DVBLEN'=F2,X(Z9)[$C(10) S DVBABORT=DVBABORT+1 U IO(0) W:'DVBTSK !,"Missing character" S DVBMISS="" Q
|
|
I $E(X(Z1),5)'=2 S F2=F2+1
|
|
;
|
|
I DVBLEN'=F2-1,X(Z9)'[$C(10),$S('$D(X(Z9-1)):1,1:$S(X(Z9-1)'[$C(10):1,1:0)) S DVBABORT=DVBABORT+1 U IO(0) W:'DVBTSK !,"Missing character" S DVBMISS="" Q
|
|
;trim,e will pack back to x(1)
|
|
I Z9 S:$D(X) DVBSOX=X D TRIM,E^DVBHQAT S:$D(DVBSOX) X=DVBSOX K DVBSOX I $E(X(1),1,4)["HINQ","AXY69"'[$E($E(X(1),5)_1) D ALLM Q
|
|
;
|
|
S DVBABORT=DVBABORT+1 Q:$E(X(1),1,4)'="HINQ"
|
|
I $E(X(1),5)="A" U IO(0) W:'DVBTSK !,"VBA File not Available" U IO H 2 D ALL QUIT
|
|
;
|
|
I DVBTSK,"69XY"[$E($E(X(1),5)_1) S DVBBADP="" D ALL QUIT
|
|
I 'Z9 Q
|
|
;
|
|
ALL I 'DVBXM,$D(DFN),+DFN K:C ^TMP("DVBHINQ",$J,DFN) S Z=0 F S Z=$O(X(Z)) Q:'Z S ^TMP("DVBHINQ",$J,DFN,Z)=X(Z)
|
|
E I DVBXM D K DVBTX Q
|
|
. N DVBQT
|
|
. D RS,A^DVBHIQR
|
|
. I $G(DFN)>1,('DVBTSK),($E(X(1),5)=2),('$D(DVBERCS)) D CHKID I DVBQT D Q
|
|
. . N DVBTMP1,DVBTMP2
|
|
. . S DVBTMP1=$G(DVBNOALR)
|
|
. . S DVBTMP2=$G(DVBJ2)
|
|
. . S DVBNOALR=";4///c;5////"_DUZ_";6///N",DVBJ2=1
|
|
. . D FILE^DVBHQUP
|
|
. . S DVBNOALR=DVBTMP1
|
|
. . S DVBJ2=DVBTMP2
|
|
. D RECMAL^DVBHQD2
|
|
. D IALERT^DVBHT2,EN^DVBHIQM H 1 D WRT
|
|
I DVBABORT=3!($D(DVBBADP)) S DFN=0
|
|
Q
|
|
; do all if no error or retrying
|
|
ALLM I "BC"'[$E($E(X(1),5)_1) D ALL Q
|
|
I CN,'TRY S TRY=1 D:DVBXM DCN Q
|
|
I 'CN D ALL Q
|
|
S X(1)=X(1)_"[TRY]1" D ALL Q
|
|
;
|
|
DCN S:$G(IO(0))="" IO(0)=$I U IO(0) W !,"..Name, SSN didn't work ....retrying using Claim Number",! U IO Q
|
|
;
|
|
RS Q:'$D(DFN) Q:'DFN Q:'$D(^DVB(395.5,DFN,0)) S DVBDFN=DFN,DVBCS=0
|
|
F DVBSZ=0:0 S DVBSZ=$O(X(DVBSZ)) D SC^DVBHQST Q:'DVBSZ D ST^DVBHQDB
|
|
K DVBSZ,DVBDFN Q
|
|
;
|
|
TRIM Q:F1=999
|
|
I '$D(F1) S F1=$F(X(Z9),DVBEND)
|
|
I $E(X(Z9),F1-F4)=$C(10) S F1=F1-1
|
|
S X(Z9)=$E(X(Z9),1,F1-F4)
|
|
K F1 Q
|
|
;
|
|
WRT S:$G(IO(0))="" IO(0)=$I S DVBJIO=IO(0)
|
|
WRT1 S:$G(DVBJIO)="" DVBJIO=$I S:'$D(DVBIOSL) DVBIOSL=IOSL S:'$D(DVBIOST) DVBIOST=IOST S:'$D(DVBIOF) DVBIOF=IOF
|
|
S X="" U DVBJIO W !!! D CODE^DVBHQUS W !! S Y0=$Y F Z=0:0 S Z=$O(^TMP($J,Z)) Q:'Z I $D(^(Z,0)) W ^(0),! D:$Y-Y0>(DVBIOSL-4) SROLL^DVBHQD2 Q:X="^" D:$Y<Y0 ABS^DVBHQD2
|
|
Q:X="^" K DVBJIO D SROLL^DVBHQD2 Q
|
|
;
|
|
CH S F1=0
|
|
I X(W)=$C(10)_"NNNN" K X(W) S F1=999 Q
|
|
I $L(X(W))>4!($L(X(W))<1) Q
|
|
F A=$L(X(W)):-1:1 Q:$E(X(W),A)'="N"
|
|
I A=1,$E(X(W),A)="N" S F1=$L(X(W-1))+1,F3=$L(X(W)),F4=5-$L(X(W)) K X(W)
|
|
Q
|
|
CHKID ;checks 4 critical identifier fields
|
|
;fields are name, DOB, SSN and sex.
|
|
;DVBQT 0 to continue, 1 to stop processing
|
|
N DA,DIC,DIQ,DIR,DR,X,Y
|
|
N DVBBIRTH,DVBCNT,DVBNAM,DVBNM,DVBSEX,DVBSOCL,DVBSSN
|
|
N DVBDIQ
|
|
S DVBCNT=0
|
|
S DVBQT=0
|
|
S DIC="^DPT(",DA=DFN,DIQ(0)="E",DIQ="DVBDIQ("
|
|
S DR=".01;.02;.03;.09"
|
|
D EN^DIQ1
|
|
S DVBNAM=$S($D(DVBADR(1)):DVBADR(1),$D(DVBNAME):$E(DVBNAME,1,30),1:"")
|
|
S DVBSEX=""
|
|
I $D(DVBVET),$P(DVBVET,U)="A" S DVBSEX=$S($P(DVBVET,U,3)="M":"MALE",$P(DVBVET,U,3)="F":"FEMALE",1:"")
|
|
I '$D(DVBVET),($D(DVBBIR)) S DVBSEX=$S($P(DVBBIR,U,25)="M":"MALE",$P(DVBBIR,U,25)="F":"FEMALE",1:"")
|
|
S DVBSOCL=""
|
|
I $D(DVBREF),($P(DVBREF,U)?9N) S DVBSOCL=$P(DVBREF,U)
|
|
I $P($G(DVBREF),U)'?9N I $D(DVBSSN),(DVBSSN?9N) S DVBSOCL=DVBSSN
|
|
S DVBBIRTH=""
|
|
;change date of birth to match the Patient file ext value (DVBBIRTH)
|
|
I $D(DVBDOB),(DVBDOB?8N) S DVBBIRTH=$E(DVBDOB,1,2)_"/"_$E(DVBDOB,3,4)_"/"_$E(DVBDOB,5,8)
|
|
;change ext Patient file value for name to HINQ name format
|
|
I '$$NAME(DVBDIQ(2,DFN,.01,"E")) S DVBCNT=DVBCNT+1
|
|
I $G(DVBSEX)'=$G(DVBDIQ(2,DFN,.02,"E")) S DVBCNT=DVBCNT+1
|
|
I $G(DVBBIRTH)'=$G(DVBDIQ(2,DFN,.03,"E")) S DVBCNT=DVBCNT+1
|
|
I $G(DVBSOCL)'=$G(DVBDIQ(2,DFN,.09,"E")) S DVBCNT=DVBCNT+1
|
|
I DVBCNT>0 D WARN
|
|
Q
|
|
WARN ;warns user if there are any discrepancies between HINQ and VistA for
|
|
;4 critical identifier fields - name, DOB, SSN and sex.
|
|
N DIRUT,DUOUT
|
|
U IO(0)
|
|
H 1
|
|
D TEXT
|
|
D DISPL
|
|
S DVBQT=1
|
|
N DIR
|
|
S DIR(0)="N^1:3:0",DIR("A")="Do you want to process the HINQ on "_DVBDIQ(2,DFN,.01,"E")_"? ",DIR("B")="NO"
|
|
W !!
|
|
S DIR("A",1)="Check displayed data before proceeding."
|
|
S DIR("A",2)=""
|
|
S DIR("A",3)="Choose one of the following:"
|
|
S DIR("A",4)=" 1. Update this record."
|
|
S DIR("A",5)=" 2. Take no action at this time."
|
|
S DIR("A",6)=" 3. Delete this record from the SUSPENSE file."
|
|
S DIR("A",7)=""
|
|
S DIR("?")=" Select 1 - 3"
|
|
S DIR("?",1)=" If you want to continue processing this HINQ enter 1."
|
|
S DIR("?",3)=" If you cannot process this patient data at this time enter 2."
|
|
S DIR("?",2)=" If the HINQ data is for the wrong patient, enter 3."
|
|
S DIR("B")=2
|
|
D ^DIR
|
|
W !!
|
|
I Y=1 S DVBQT=0 Q ;update
|
|
I Y=2 Q ;ignore
|
|
I Y="^"!($G(DIRUT)=1)!($G(DUOUT)=1) S DVBOUT="^" Q ;"^" out of option
|
|
N DA,DIK ;delete
|
|
S DA=DFN
|
|
S DIK="^DVB(395.5,"
|
|
D ^DIK
|
|
Q
|
|
TEXT ;warning text
|
|
W @IOF
|
|
W !!!!
|
|
W ?2,"*********************************************************************"
|
|
W !?2,"* NOTE: IDENTIFYING DATA FROM HINQ AND VISTA DOES NOT MATCH *"
|
|
W !?2,"* PATIENT FROM HINQ RESPONSE MAY NOT BE THE PATIENT REQUESTED *"
|
|
W !?2,"*********************************************************************"
|
|
Q
|
|
DISPL ;display ID data
|
|
W !!?17,"Patient File data",?45,"HINQ Data"
|
|
W !?17,"-----------------",?45,"---------"
|
|
W !?11,"Name: "_$G(DVBDIQ(2,DFN,.01,"E")),?45,$G(DVBNAM)
|
|
W !?12,"Sex: "_$G(DVBDIQ(2,DFN,.02,"E")),?45,$G(DVBSEX)
|
|
W !?2,"Date of Birth: "_$G(DVBDIQ(2,DFN,.03,"E")),?45,$G(DVBBIRTH)
|
|
W !?12,"SSN: "_$G(DVBDIQ(2,DFN,.09,"E")),?45,$G(DVBSOCL)
|
|
Q
|
|
NAME(DVBNM) ;set local variables to hold the VistA and HINQ formats of the
|
|
;patient name so they can be compared, DVB*4*56
|
|
;first check for the HINQ name on the first address line
|
|
N DVBARR,DVBHFRST,DVBHLST,DVBHMID,DVBOK,DVBSTUB,DVBVFRST,DVBVLST,DVBVMID
|
|
S (DVBARR,DVBOK,DVBSTUB)=0
|
|
;set variable with HINQ name parts
|
|
I $G(DVBADR(1))]"" D
|
|
. S DVBARR=1
|
|
. S DVBHFRST=$P(DVBADR(1)," ") ;first name
|
|
. S DVBHMID=$P(DVBADR(1)," ",2) ;middle name, if there is one
|
|
. S DVBHLST=$P(DVBADR(1)," ",3) ;last name, if there was a middle name
|
|
;then check for the HINQ 7 character name stub
|
|
I DVBARR=0,($G(DVBNAME)]"") S DVBSTUB=1
|
|
;get VistA name parts
|
|
N DVBREST
|
|
S DVBVLST=$P(DVBNM,",")
|
|
S DVBREST=$P(DVBNM,",",2,3)
|
|
S DVBVFRST=$P(DVBREST," ")
|
|
S DVBVMID=$P(DVBREST," ",2)
|
|
;now compare
|
|
I DVBARR=1 D Q DVBOK
|
|
. N DVBOK1,DVBOK2,DVBOK3
|
|
. S (DVBOK1,DVBOK2,DVBOK3)=0
|
|
. ;if name is long, HINQ first name may have been truncated to 1 char
|
|
. I $L(DVBHFRST)=1 S DVBVFRST=$E(DVBVFRST)
|
|
. ;if last name is > 16 chars, it may be truncated
|
|
. I $L(DVBVLST)>16 S DVBVLST=$E(DVBVLST,1,$L(DVBHLST))
|
|
. ;if name is long, HINQ middle name may have been truncated to 1 char
|
|
. ;but, if there is no HINQ middle name, do not try to compare
|
|
. I $G(DVBHMID)']"" S DVBOK3=1
|
|
. I DVBOK3=0 D
|
|
. . I $L(DVBHMID)=1 S DVBVMID=$E(DVBVMID)
|
|
. . I DVBVMID=DVBHMID S DVBOK3=1
|
|
. I DVBVFRST=DVBHFRST S DVBOK1=1
|
|
. I DVBVLST=DVBHLST S DVBOK2=1
|
|
. I DVBOK1=1,(DVBOK2=1),(DVBOK3=1) S DVBOK=1 Q
|
|
;if the first line of the address array is not populated, compare
|
|
;DVBNAME which is a HINQ stub name to the equivalent patient file stub
|
|
I DVBARR=0,(DVBSTUB=1) D
|
|
. N DVBVSTUB
|
|
. I DVBVMID']"" S DVBVMID=" "
|
|
. S DVBVSTUB=$E(DVBVFRST)_$E(DVBVMID)_$E(DVBVLST,1,5)
|
|
. I DVBVSTUB=DVBNAME S DVBOK=1
|
|
Q DVBOK
|