ACHSDLK ; IHS/ITSC/PMF - DENIAL LOOKUP ; [ 10/31/2003 11:41 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUNE 11, 2001
;ACHS*3.1*1 expand prompt for denial number to include patient name
;ACHS*3.1*3 added search for non registered patients
; Overhauled routine structure so that THIS ALL LOOKS NEW
;ACHS*3.1*4 include issue and service dates on line display
;ACHS*3.1*6 3.28.03 IHS/SET/FCJ Not able to look up non reg patients
; format problems on display
;
;12/20/01 pmf
;I have saved off this routine to ACHSDLKS if we need to roll back or
;check against the previous version.
;
;
K ACHDLKER,DFN
S DIWL=5,DIWR=75,DIWF="W"
N DONE S DONE=0
;
;keep asking them for a denial until we get DONE
;DONE can mean we got one, or we are ready to quit
F D Q:DONE
. D GETDEN
. I $D(ACHDLKER) S DONE=1 Q
. I ACHSA="" S (ACHDLKER,DONE)=1 Q
. D PP
. Q
;
K DIC
Q
;
;
GETDEN ;get a denial, either by number or by patient
W !!
K DFN,DIC,Y S ACHSA=""
S DIR("A")="Enter the DENIAL NUMBER or PATIENT"
S DIR("?")="Enter either the denial number or a Patient Identifier (Name, HRN, SSN, DOB)"
S DIR(0)="FO" D ^DIR K DIR
;
;now the responses. if quit, quit.
Q:$D(DIRUT)
;
;see if the input is a real, full denial case number
;if so, X will not be null after this
S X="",X=$O(^ACHSDEN(DUZ(2),"D","B",Y,""))
;
;if they entered a blank space or a denial number, use
;^DIC to load info
I Y=" "!X S X="" D GETDEN2("EMZ",Y) Q:ACHSA'="" W " ","??" G GETDEN
;
;ACHS*3.1*6 3.28.03 IHS/SET/FCJ ADD NXT 4 LINES TO LST DENIAL PATIENTS
;Registered and non-registered
S X=Y,ACHSTMP=Y ;SAVE VAR FOR RETURN FR GETDEN2
I X'?1N.N D GETDEN2("EMZ",X)
I $D(DTOUT)!$D(DUOUT) G GETDEN
Q:ACHSA'=""
;
;first, try patient lookup for registered patients
;ACHS*3.1*6 3.28.03 IHS/SET/FCJ Y VALUE WAS CHANGED IN CALL TO GETDEN
;S X=Y,DIC="^AUPNPAT(",DIC(0)="EM",AUPNLK("ALL")=1 ;ACHS*3.1*6
S X=ACHSTMP,DIC="^AUPNPAT(",DIC(0)="EM",AUPNLK("ALL")=1 ;ACHS*3.1*6
D ^DIC
;
;if that didn't work, try looking up unregistered patients
;if it works, stop, if it doesn't go back to the top
I +Y<0 D Q:ACHSA'="" W " ","??" G GETDEN
. D GETDEN2("EMZ",X)
. ;I +Y<1 S ACHDLKER="" G END
. ;S ACHSA=+Y
;
;if we DID find a registered patient, submit that and get denial
S PATDAT=$G(^DPT(+Y,0))
I PATDAT="" G GETDEN
D GETDEN2("EMZ",$P(PATDAT,U,1))
I +Y<0 W " ","??" G GETDEN
S ACHSA=+Y
;
K ACHSTMP ;ACHS*3.1*6 3.28.03 IHS/SET/FCJ ADDED K ACHSTMP
Q
;
GETDEN2(DIC0,X) ;
;use ^DIC to get a denial case.
;input: DIC0 the value to give DIC(0)
; X the input value for ^DIC, not manditory
S X=$G(X)
K DIC
S DIC="^ACHSDEN("_DUZ(2)_",""D"","
S DIC(0)=DIC0
S DIC("A")="Enter the DENIAL NUMBER or PATIENT: "
S DIC("S")="I $P($G(^(0)),U)'[""#"""
S DA(1)=DUZ(2)
;
;ACHS*3.1*4 3/28/02 pmf add issue and service date to display
;ACHS*3.1*6 3.28.03 IHS/SET/FCJ FIX SPACE DISPLAY
;S DIC("W")="W ""ISS: "",$E($P(^(0),U,2),4,5),""/"",$E($P(^(0),U,2),6,7),""/"",($E($P(^(0),U,2),1,3)+1700),"" SERV: "",$E($P(^(0),U,4),4,5),""/"",$E($P(^(0),U,4),6,7),""/"",($E($P(^(0),U,4),1,3)+1700)" ; ACHS*3.1*6
S DIC("W")="W "" ISS: "",$E($P(^(0),U,2),4,5),""/"",$E($P(^(0),U,2),6,7),""/"",($E($P(^(0),U,2),1,3)+1700),"" SRV: "",$E($P(^(0),U,4),4,5),""/"",$E($P(^(0),U,4),6,7),""/"",($E($P(^(0),U,4),1,3)+1700)" ; ACHS*3.1*6
;
;
D ^DIC
Q:+Y<0
S ACHSA=+Y
Q
;
PP ;
S Y(0)=$G(Y(0))
G P0:$P(Y(0),U,6)'="Y"!($P(Y(0),U,7)']"")
G P0:'$D(^DPT($P(Y(0),U,7),0))
S DFN=$P(Y(0),U,7)
G P1
;
P0 ;
G NAMERR:'$D(^ACHSDEN(DUZ(2),"D",ACHSA,10))
G NAMERR:$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,10)),U)']""
P1 ;
W !!,"You have chosen "_ACHDOCT_" document ",$P(Y(0),U),!!
G P2:'$D(DFN)
W $P($G(^DPT(DFN,0)),U),!
S A=$G(^DPT(DFN,.11))
W $P(A,U),!,$P(A,U,4)
S ACHDST=$P(A,U,5)
I ACHDST]"",$D(^DIC(5,ACHDST,0)) W " ",$P($G(^DIC(5,ACHDST,0)),U,2)
W " ",$P(A,U,6),!!
G P3
;
P2 ;
S A=$G(^ACHSDEN(DUZ(2),"D",ACHSA,10))
W $P(A,U),!,$P(A,U,2),!,$P(A,U,3)
S ACHDST=$P(A,U,4)
I ACHDST]"",$D(^DIC(5,ACHDST,0)) W " ",$P($G(^DIC(5,ACHDST,0)),U,2)
W " ",$P(A,U,5),!!
P3 ;
W "Date of service ",$$FMTE^XLFDT($$DN^ACHS(0,4)),!!
S %=$$DIR^ACHS("Y","Is this correct","YES","Did you select the correct document?","",2)
I $D(DTOUT)!$D(DUOUT) S ACHDLKER="",DONE=1
I % S DONE=1
Q
;
NAMERR ;
W !!,*7,"No valid PATIENT NAME in this file.",!,"No letter may be printed until a valid patient is entered.",!!
Q
;
ACHSDLK ; IHS/ITSC/PMF - DENIAL LOOKUP ; [ 10/31/2003 11:41 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUNE 11, 2001
+2 ;ACHS*3.1*1 expand prompt for denial number to include patient name
+3 ;ACHS*3.1*3 added search for non registered patients
+4 ; Overhauled routine structure so that THIS ALL LOOKS NEW
+5 ;ACHS*3.1*4 include issue and service dates on line display
+6 ;ACHS*3.1*6 3.28.03 IHS/SET/FCJ Not able to look up non reg patients
+7 ; format problems on display
+8 ;
+9 ;12/20/01 pmf
+10 ;I have saved off this routine to ACHSDLKS if we need to roll back or
+11 ;check against the previous version.
+12 ;
+13 ;
+14 KILL ACHDLKER,DFN
+15 SET DIWL=5
SET DIWR=75
SET DIWF="W"
+16 NEW DONE
SET DONE=0
+17 ;
+18 ;keep asking them for a denial until we get DONE
+19 ;DONE can mean we got one, or we are ready to quit
+20 FOR
Begin DoDot:1
+21 DO GETDEN
+22 IF $DATA(ACHDLKER)
SET DONE=1
QUIT
+23 IF ACHSA=""
SET (ACHDLKER,DONE)=1
QUIT
+24 DO PP
+25 QUIT
End DoDot:1
IF DONE
QUIT
+26 ;
+27 KILL DIC
+28 QUIT
+29 ;
+30 ;
GETDEN ;get a denial, either by number or by patient
+1 WRITE !!
+2 KILL DFN,DIC,Y
SET ACHSA=""
+3 SET DIR("A")="Enter the DENIAL NUMBER or PATIENT"
+4 SET DIR("?")="Enter either the denial number or a Patient Identifier (Name, HRN, SSN, DOB)"
+5 SET DIR(0)="FO"
DO ^DIR
KILL DIR
+6 ;
+7 ;now the responses. if quit, quit.
+8 IF $DATA(DIRUT)
QUIT
+9 ;
+10 ;see if the input is a real, full denial case number
+11 ;if so, X will not be null after this
+12 SET X=""
SET X=$ORDER(^ACHSDEN(DUZ(2),"D","B",Y,""))
+13 ;
+14 ;if they entered a blank space or a denial number, use
+15 ;^DIC to load info
+16 IF Y=" "!X
SET X=""
DO GETDEN2("EMZ",Y)
IF ACHSA'=""
QUIT
WRITE " ","??"
GOTO GETDEN
+17 ;
+18 ;ACHS*3.1*6 3.28.03 IHS/SET/FCJ ADD NXT 4 LINES TO LST DENIAL PATIENTS
+19 ;Registered and non-registered
+20 ;SAVE VAR FOR RETURN FR GETDEN2
SET X=Y
SET ACHSTMP=Y
+21 IF X'?1N.N
DO GETDEN2("EMZ",X)
+22 IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO GETDEN
+23 IF ACHSA'=""
QUIT
+24 ;
+25 ;first, try patient lookup for registered patients
+26 ;ACHS*3.1*6 3.28.03 IHS/SET/FCJ Y VALUE WAS CHANGED IN CALL TO GETDEN
+27 ;S X=Y,DIC="^AUPNPAT(",DIC(0)="EM",AUPNLK("ALL")=1 ;ACHS*3.1*6
+28 ;ACHS*3.1*6
SET X=ACHSTMP
SET DIC="^AUPNPAT("
SET DIC(0)="EM"
SET AUPNLK("ALL")=1
+29 DO ^DIC
+30 ;
+31 ;if that didn't work, try looking up unregistered patients
+32 ;if it works, stop, if it doesn't go back to the top
+33 IF +Y<0
Begin DoDot:1
+34 DO GETDEN2("EMZ",X)
+35 ;I +Y<1 S ACHDLKER="" G END
+36 ;S ACHSA=+Y
End DoDot:1
IF ACHSA'=""
QUIT
WRITE " ","??"
GOTO GETDEN
+37 ;
+38 ;if we DID find a registered patient, submit that and get denial
+39 SET PATDAT=$GET(^DPT(+Y,0))
+40 IF PATDAT=""
GOTO GETDEN
+41 DO GETDEN2("EMZ",$PIECE(PATDAT,U,1))
+42 IF +Y<0
WRITE " ","??"
GOTO GETDEN
+43 SET ACHSA=+Y
+44 ;
+45 ;ACHS*3.1*6 3.28.03 IHS/SET/FCJ ADDED K ACHSTMP
KILL ACHSTMP
+46 QUIT
+47 ;
GETDEN2(DIC0,X) ;
+1 ;use ^DIC to get a denial case.
+2 ;input: DIC0 the value to give DIC(0)
+3 ; X the input value for ^DIC, not manditory
+4 SET X=$GET(X)
+5 KILL DIC
+6 SET DIC="^ACHSDEN("_DUZ(2)_",""D"","
+7 SET DIC(0)=DIC0
+8 SET DIC("A")="Enter the DENIAL NUMBER or PATIENT: "
+9 SET DIC("S")="I $P($G(^(0)),U)'[""#"""
+10 SET DA(1)=DUZ(2)
+11 ;
+12 ;ACHS*3.1*4 3/28/02 pmf add issue and service date to display
+13 ;ACHS*3.1*6 3.28.03 IHS/SET/FCJ FIX SPACE DISPLAY
+14 ;S DIC("W")="W ""ISS: "",$E($P(^(0),U,2),4,5),""/"",$E($P(^(0),U,2),6,7),""/"",($E($P(^(0),U,2),1,3)+1700),"" SERV: "",$E($P(^(0),U,4),4,5),""/"",$E($P(^(0),U,4),6,7),""/"",($E($P(^(0),U,4),1,3)+1700)" ; ACHS*3.1*6
+15 ; ACHS*3.1*6
SET DIC("W")="W "" ISS: "",$E($P(^(0),U,2),4,5),""/"",$E($P(^(0),U,2),6,7),""/"",($E($P(^(0),U,2),1,3)+1700),"" SRV: "",$E($P(^(0),U,4),4,5),""/"",$E($P(^(0),U,4),6,7),""/"",($E($P(^(0),U,4),1,3)+1700)"
+16 ;
+17 ;
+18 DO ^DIC
+19 IF +Y<0
QUIT
+20 SET ACHSA=+Y
+21 QUIT
+22 ;
PP ;
+1 SET Y(0)=$GET(Y(0))
+2 IF $PIECE(Y(0),U,6)'="Y"!($PIECE(Y(0),U,7)']"")
GOTO P0
+3 IF '$DATA(^DPT($PIECE(Y(0),U,7),0))
GOTO P0
+4 SET DFN=$PIECE(Y(0),U,7)
+5 GOTO P1
+6 ;
P0 ;
+1 IF '$DATA(^ACHSDEN(DUZ(2),"D",ACHSA,10))
GOTO NAMERR
+2 IF $PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,10)),U)']""
GOTO NAMERR
P1 ;
+1 WRITE !!,"You have chosen "_ACHDOCT_" document ",$PIECE(Y(0),U),!!
+2 IF '$DATA(DFN)
GOTO P2
+3 WRITE $PIECE($GET(^DPT(DFN,0)),U),!
+4 SET A=$GET(^DPT(DFN,.11))
+5 WRITE $PIECE(A,U),!,$PIECE(A,U,4)
+6 SET ACHDST=$PIECE(A,U,5)
+7 IF ACHDST]""
IF $DATA(^DIC(5,ACHDST,0))
WRITE " ",$PIECE($GET(^DIC(5,ACHDST,0)),U,2)
+8 WRITE " ",$PIECE(A,U,6),!!
+9 GOTO P3
+10 ;
P2 ;
+1 SET A=$GET(^ACHSDEN(DUZ(2),"D",ACHSA,10))
+2 WRITE $PIECE(A,U),!,$PIECE(A,U,2),!,$PIECE(A,U,3)
+3 SET ACHDST=$PIECE(A,U,4)
+4 IF ACHDST]""
IF $DATA(^DIC(5,ACHDST,0))
WRITE " ",$PIECE($GET(^DIC(5,ACHDST,0)),U,2)
+5 WRITE " ",$PIECE(A,U,5),!!
P3 ;
+1 WRITE "Date of service ",$$FMTE^XLFDT($$DN^ACHS(0,4)),!!
+2 SET %=$$DIR^ACHS("Y","Is this correct","YES","Did you select the correct document?","",2)
+3 IF $DATA(DTOUT)!$DATA(DUOUT)
SET ACHDLKER=""
SET DONE=1
+4 IF %
SET DONE=1
+5 QUIT
+6 ;
NAMERR ;
+1 WRITE !!,*7,"No valid PATIENT NAME in this file.",!,"No letter may be printed until a valid patient is entered.",!!
+2 QUIT
+3 ;
