ACHSDADP ; IHS/ITSC/JVK - DENIAL APPEAL DISPLAY/EDIT; [ 09/21/2006 3:05 PM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**6,13**;JUNE 11, 2001
;ACHS*3.1.* 7/1/2003 NEW ROUTINE TO ENTER APPEAL STATUS
;AND APPEAL LEVEL
;ACHS*3.1*13 9.8.06 IHS/OIT/FCJ MISSING Q, SCREEN NOT UPDATING, ADDED
; INTERFACE TO RCIS REFERRAL
;
K DFN S ACHDOCT="denial"
D ^ACHSDLK
I $D(ACHDLKER) D RTRN^ACHS Q
S DA=ACHSA
TOF ;
Q:'$D(ACHSA)
Q:'$D(^ACHSDEN(DUZ(2),"D",ACHSA,0))
W @IOF
DSP ; --- Display
D VIDEO^ACHS
S:'$D(IORVON) IORVON=""
S:'$D(IORVOFF) IORVOFF=""
D HDR,P1
G:'$D(DUOUT) TOF
END ;
K ACHSI,ACHSJ,ACHSPRNF,ACHSPROF,ACHSMPRI
Q
;
HDR ;
S ACHDPAT=$S($$DN^ACHS(0,7):$P($G(^DPT($$DN^ACHS(0,7),0)),U),1:$$DN^ACHS(10,1))
W IORVON,!?79,!,"CHS DENIAL DISPLAY",?25,"PATIENT: ",$E(ACHDPAT,1,25),?62,"CHART#: "
I $$DN^ACHS(0,6)="Y",$$DN^ACHS(0,7),$G(^AUPNPAT($$DN^ACHS(0,7),41,DUZ(2),0)) W $P($G(^AUPNPAT($$DN^ACHS(0,7),41,DUZ(2),0)),U,2)
E W "NONE"
W !?79,IORVOFF,!,$$REPEAT^XLFSTR("=",79),!
Q
;
P1 ; --- Display Page 1
W IORVOFF
S STATUS=$$DN^ACHS(0,8)
W "DENIAL NO: ",$$DN^ACHS(0,1),?45,"DENIAL STATUS: ",$S(STATUS="":"Active",STATUS="Y":"Canceled",STATUS="R":"Reversed"),!
W "DATE ISSUED: ",$$FMTE^XLFDT($$DN^ACHS(0,2))
W ?45,"ISSUED BY: ",$E($P($G(^VA(200,$$DN^ACHS(0,3),0)),U),1,25)
W !!,"1. DATE MED SVC: ",$$FMTE^XLFDT($$DN^ACHS(0,4))
W ?43,"2. DATE OF REQUEST: ",$$FMTE^XLFDT($$DN^ACHS(0,5))
;ITSC/SET/JVK ACHS*3.1*6 MEDICAL PRIORITY ORIGNALLY NOT REQUIRED FIELD
S ACHSMPRI=$$DN^ACHS(400,2)
;W !,"3. MEDICAL PRIORITY: ",$P($G(^ACHSMPRI($$DN^ACHS(400,2),0)),U)
W !,"3. MEDICAL PRIORITY: ",$S(ACHSMPRI'="":$P($G(^ACHSMPRI($$DN^ACHS(400,2),0)),U),ACHSMPRI="":"NONE SET")
S %=$$DN^ACHS(100,10)
;
W !,"4. VISIT TYPE: ",$S(%="O":"OUTPATIENT",%="I":"INPATIENT",%="A":"AMBULANCE",%="P":"PATIENT ESCORT",%="D":"DENTAL",1:"UNKNOWN")
;
W !!,"5. PRIMARY PROVIDER: ",?25,$S($$DN^ACHS(100,1)="Y":$P($G(^AUTTVNDR($$DN^ACHS(100,2),0)),U),1:$$DN^ACHS(100,3))
;
W !,"6. SECONDARY PROVIDERS: "
;--Other providers on file Node 200
S ACHSI=0
F ACHSJ=1:1:3 S ACHSI=$O(^ACHSDEN(DUZ(2),"D",ACHSA,200,ACHSI)) Q:ACHSI'?1N.N D
. S ACHSPROF(ACHSJ)=$P(^ACHSDEN(DUZ(2),"D",ACHSA,200,ACHSI,0),U)
. S ACHSPROF(ACHSJ)=$P(^AUTTVNDR(ACHSPROF(ACHSJ),0),U)
. W ?25,ACHSPROF(ACHSJ),!
;--Other providers not on file Node 210
S ACHSI=0
F ACHSJ=1:1:3 S ACHSI=$O(^ACHSDEN(DUZ(2),"D",ACHSA,210,ACHSI)) Q:ACHSI'?1N.N D
. S ACHSPRNF(ACHSJ)=$P(^ACHSDEN(DUZ(2),"D",ACHSA,210,ACHSI,0),U)
. W ?25,ACHSPRNF(ACHSJ),!
;
W !,"7. PRIMARY DENIAL REASON: " S %=$$DN^ACHS(250,1) I % W $P($G(^ACHSDENS(%,0)),U)
;
W !,"8. *OTHER RESOURCES: ",$S($P($G(^ACHSDEN(DUZ(2),"D",ACHSA,800,0)),U,4):"YES",1:"NONE")
;
W ?43,"9. *OTHER IHS RESOURCES: ",$S($P($G(^ACHSDEN(DUZ(2),"D",ACHSA,825,0)),U,4):"YES",1:"NONE")
;
S %=$$DN^ACHS(400,3)
W !,"10. APPEAL STATUS: ",IORVON,$S(%'="":$P($G(^ACHSDENA(%,0)),U),1:"NONE"),IORVOFF
S %=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,431,0)),U,4)
W ?42,"11. *APPEAL TRANSACTION RECORDS: ",$S(%'="":$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,431,0)),U,4),1:"NONE")
W !,"12. *CHS OFFICE COMMENTS: ",$S($D(^ACHSDEN(DUZ(2),"D",ACHSA,900,0)):"YES",1:"NONE")
;
W !?15,IORVON,"*",IORVOFF," - CHOOSE THESE FIELDS TO SEE FURTHER INFORMATION",!
;
S %=$$DIR^ACHS("LO^8:12","Enter Number Of Field To Edit or <RETURN> To Accept","","","","")
;
I %="" S DUOUT=""
Q:$D(DUOUT)!$D(DTOUT)!'%
D @(+%)
Q
;
8 ; --- Other Resources
W !!
I '$$DIE(800) S DUOUT=""
Q
;
;'OTHER IHS RESOURCES'
9 ;
W !!
I '$$DIE(825) S DUOUT=""
Q
;
10 ;
;ITSC-SET-JVK 5/27/03 ACHS*3.1*6
;I '$$DIE(430) S DUOUT=""
W @IOF
W ?20,"APPEAL TRANSACTION MENU",!
I '$$DIE(431) S DUOUT=""
Q
11 ;
W @IOF
W ?20,"APPEAL TRANSACTION MENU",!
I '$$DIE(431) S DUOUT=""
Q
;
12 ;
W !!
I '$$DIE(900) S DUOUT=""
Q
;
DIE(DR) ; --- Edit appropriate fields in Denial
W !!
S DA=ACHSA
S DA(1)=DUZ(2)
S DIE="^ACHSDEN("_DUZ(2)_",""D"","
I '$$LOCK^ACHS("^ACHSDEN(DUZ(2),""D"",ACHSA)","+") Q 0
D ^DIE
;ACHS*3.1*13 8.31.06 IHS.OIT.FCJ ADDED CALL TO REF IN NXT LINE
I DR=431 D APPEAL,REF
I '$$LOCK^ACHS("^ACHSDEN(DUZ(2),""D"",ACHSA)","-") Q 0
Q 1
APPEAL ;--ENTER OR EDIT APPEAL TRANSACTIONS--
S ACHSTREC=$P(D,U,2)
S ACHSDREC=$P(^ACHSDEN(DUZ(2),"D",ACHSA,400),U,3)
;S %=$$DIR^ACHS("Y","DO YOU WANT TO CHANGE THE DENIAL APPEAL STATUS","NO","By entering NO only the appeal status in the transaction record is changed.","","")
;I Y S $P(^ACHSDEN(DUZ(2),"D",ACHSA,400),U,3)=ACHSTREC
;
;ITSC-SET-JVK 5/27/03 ACHS*3.1*6
I ACHSDREC="" S $P(^ACHSDEN(DUZ(2),"D",ACHSA,400),U,3)=ACHSTREC
I ACHSTREC="" S $P(^ACHSDEN(DUZ(2),"D",ACHSA,400),U,3)=""
I ACHSDREC'=ACHSTREC S $P(^ACHSDEN(DUZ(2),"D",ACHSA,400),U,3)=ACHSTREC
S %=$$DN^ACHS(400,3)
I %="" S $P(ACHSDEN(DUZ(2),"D",ACHSA,0),U,8)="" Q
I $$GET1^DIQ(9002074,%,.01,"I")="REVERSED AFTER APPEAL" S $P(^ACHSDEN(DUZ(2),"D",ACHSA,0),U,8)="R"
I $$GET1^DIQ(9002074,%,.01,"I")="PAYED WITH ADDITIONAL MONEY" S $P(^ACHSDEN(DUZ(2),"D",ACHSA,0),U,8)="R"
I $$GET1^DIQ(9002074,%,.01,"I")="APPEAL PENDING" S $P(^ACHSDEN(DUZ(2),"D",ACHSA,0),U,8)=""
I $$GET1^DIQ(9002074,%,.01,"I")="UPHELD AFTER APPEAL" S $P(^ACHSDEN(DUZ(2),"D",ACHSA,0),U,8)=""
Q ;ACHS*3.1*13 8.31.06 IHS.OIT.FCJ
;ACHS*3.1*13 8.31.06 IHS.OIT.FCJ ST OF CHANGES TO CALL INTERFACE W/RCIS
REF ;UPDATE REFERRAL IF DENIAL EXIST AND LINK IS ON
;GET REF IF DOES NOT EXIST WRITE ERROR MESSAGE WITH A RET TO CONT
I $$LINK^ACHSBMC D
.S ACHSREC=""
.S ACHSREC=^ACHSDEN(DUZ(2),"D",ACHSA,431,D1,0) D APPEAL^ACHSBMC
.K ACHSREC
Q
;ACHS*3.1*13 8.31.06 IHS.OIT.FCJ END OF CHANGES
ACHSDADP ; IHS/ITSC/JVK - DENIAL APPEAL DISPLAY/EDIT; [ 09/21/2006 3:05 PM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**6,13**;JUNE 11, 2001
+2 ;ACHS*3.1.* 7/1/2003 NEW ROUTINE TO ENTER APPEAL STATUS
+3 ;AND APPEAL LEVEL
+4 ;ACHS*3.1*13 9.8.06 IHS/OIT/FCJ MISSING Q, SCREEN NOT UPDATING, ADDED
+5 ; INTERFACE TO RCIS REFERRAL
+6 ;
+7 KILL DFN
SET ACHDOCT="denial"
+8 DO ^ACHSDLK
+9 IF $DATA(ACHDLKER)
DO RTRN^ACHS
QUIT
+10 SET DA=ACHSA
TOF ;
+1 IF '$DATA(ACHSA)
QUIT
+2 IF '$DATA(^ACHSDEN(DUZ(2),"D",ACHSA,0))
QUIT
+3 WRITE @IOF
DSP ; --- Display
+1 DO VIDEO^ACHS
+2 IF '$DATA(IORVON)
SET IORVON=""
+3 IF '$DATA(IORVOFF)
SET IORVOFF=""
+4 DO HDR
DO P1
+5 IF '$DATA(DUOUT)
GOTO TOF
END ;
+1 KILL ACHSI,ACHSJ,ACHSPRNF,ACHSPROF,ACHSMPRI
+2 QUIT
+3 ;
HDR ;
+1 SET ACHDPAT=$SELECT($$DN^ACHS(0,7):$PIECE($GET(^DPT($$DN^ACHS(0,7),0)),U),1:$$DN^ACHS(10,1))
+2 WRITE IORVON,!?79,!,"CHS DENIAL DISPLAY",?25,"PATIENT: ",$EXTRACT(ACHDPAT,1,25),?62,"CHART#: "
+3 IF $$DN^ACHS(0,6)="Y"
IF $$DN^ACHS(0,7)
IF $GET(^AUPNPAT($$DN^ACHS(0,7),41,DUZ(2),0))
WRITE $PIECE($GET(^AUPNPAT($$DN^ACHS(0,7),41,DUZ(2),0)),U,2)
+4 IF '$TEST
WRITE "NONE"
+5 WRITE !?79,IORVOFF,!,$$REPEAT^XLFSTR("=",79),!
+6 QUIT
+7 ;
P1 ; --- Display Page 1
+1 WRITE IORVOFF
+2 SET STATUS=$$DN^ACHS(0,8)
+3 WRITE "DENIAL NO: ",$$DN^ACHS(0,1),?45,"DENIAL STATUS: ",$SELECT(STATUS="":"Active",STATUS="Y":"Canceled",STATUS="R":"Reversed"),!
+4 WRITE "DATE ISSUED: ",$$FMTE^XLFDT($$DN^ACHS(0,2))
+5 WRITE ?45,"ISSUED BY: ",$EXTRACT($PIECE($GET(^VA(200,$$DN^ACHS(0,3),0)),U),1,25)
+6 WRITE !!,"1. DATE MED SVC: ",$$FMTE^XLFDT($$DN^ACHS(0,4))
+7 WRITE ?43,"2. DATE OF REQUEST: ",$$FMTE^XLFDT($$DN^ACHS(0,5))
+8 ;ITSC/SET/JVK ACHS*3.1*6 MEDICAL PRIORITY ORIGNALLY NOT REQUIRED FIELD
+9 SET ACHSMPRI=$$DN^ACHS(400,2)
+10 ;W !,"3. MEDICAL PRIORITY: ",$P($G(^ACHSMPRI($$DN^ACHS(400,2),0)),U)
+11 WRITE !,"3. MEDICAL PRIORITY: ",$SELECT(ACHSMPRI'="":$PIECE($GET(^ACHSMPRI($$DN^ACHS(400,2),0)),U),ACHSMPRI="":"NONE SET")
+12 SET %=$$DN^ACHS(100,10)
+13 ;
+14 WRITE !,"4. VISIT TYPE: ",$SELECT(%="O":"OUTPATIENT",%="I":"INPATIENT",%="A":"AMBULANCE",%="P":"PATIENT ESCORT",%="D":"DENTAL",1:"UNKNOWN")
+15 ;
+16 WRITE !!,"5. PRIMARY PROVIDER: ",?25,$SELECT($$DN^ACHS(100,1)="Y":$PIECE($GET(^AUTTVNDR($$DN^ACHS(100,2),0)),U),1:$$DN^ACHS(100,3))
+17 ;
+18 WRITE !,"6. SECONDARY PROVIDERS: "
+19 ;--Other providers on file Node 200
+20 SET ACHSI=0
+21 FOR ACHSJ=1:1:3
SET ACHSI=$ORDER(^ACHSDEN(DUZ(2),"D",ACHSA,200,ACHSI))
IF ACHSI'?1N.N
QUIT
Begin DoDot:1
+22 SET ACHSPROF(ACHSJ)=$PIECE(^ACHSDEN(DUZ(2),"D",ACHSA,200,ACHSI,0),U)
+23 SET ACHSPROF(ACHSJ)=$PIECE(^AUTTVNDR(ACHSPROF(ACHSJ),0),U)
+24 WRITE ?25,ACHSPROF(ACHSJ),!
End DoDot:1
+25 ;--Other providers not on file Node 210
+26 SET ACHSI=0
+27 FOR ACHSJ=1:1:3
SET ACHSI=$ORDER(^ACHSDEN(DUZ(2),"D",ACHSA,210,ACHSI))
IF ACHSI'?1N.N
QUIT
Begin DoDot:1
+28 SET ACHSPRNF(ACHSJ)=$PIECE(^ACHSDEN(DUZ(2),"D",ACHSA,210,ACHSI,0),U)
+29 WRITE ?25,ACHSPRNF(ACHSJ),!
End DoDot:1
+30 ;
+31 WRITE !,"7. PRIMARY DENIAL REASON: "
SET %=$$DN^ACHS(250,1)
IF %
WRITE $PIECE($GET(^ACHSDENS(%,0)),U)
+32 ;
+33 WRITE !,"8. *OTHER RESOURCES: ",$SELECT($PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,800,0)),U,4):"YES",1:"NONE")
+34 ;
+35 WRITE ?43,"9. *OTHER IHS RESOURCES: ",$SELECT($PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,825,0)),U,4):"YES",1:"NONE")
+36 ;
+37 SET %=$$DN^ACHS(400,3)
+38 WRITE !,"10. APPEAL STATUS: ",IORVON,$SELECT(%'="":$PIECE($GET(^ACHSDENA(%,0)),U),1:"NONE"),IORVOFF
+39 SET %=$PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,431,0)),U,4)
+40 WRITE ?42,"11. *APPEAL TRANSACTION RECORDS: ",$SELECT(%'="":$PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,431,0)),U,4),1:"NONE")
+41 WRITE !,"12. *CHS OFFICE COMMENTS: ",$SELECT($DATA(^ACHSDEN(DUZ(2),"D",ACHSA,900,0)):"YES",1:"NONE")
+42 ;
+43 WRITE !?15,IORVON,"*",IORVOFF," - CHOOSE THESE FIELDS TO SEE FURTHER INFORMATION",!
+44 ;
+45 SET %=$$DIR^ACHS("LO^8:12","Enter Number Of Field To Edit or <RETURN> To Accept","","","","")
+46 ;
+47 IF %=""
SET DUOUT=""
+48 IF $DATA(DUOUT)!$DATA(DTOUT)!'%
QUIT
+49 DO @(+%)
+50 QUIT
+51 ;
8 ; --- Other Resources
+1 WRITE !!
+2 IF '$$DIE(800)
SET DUOUT=""
+3 QUIT
+4 ;
+5 ;'OTHER IHS RESOURCES'
9 ;
+1 WRITE !!
+2 IF '$$DIE(825)
SET DUOUT=""
+3 QUIT
+4 ;
10 ;
+1 ;ITSC-SET-JVK 5/27/03 ACHS*3.1*6
+2 ;I '$$DIE(430) S DUOUT=""
+3 WRITE @IOF
+4 WRITE ?20,"APPEAL TRANSACTION MENU",!
+5 IF '$$DIE(431)
SET DUOUT=""
+6 QUIT
11 ;
+1 WRITE @IOF
+2 WRITE ?20,"APPEAL TRANSACTION MENU",!
+3 IF '$$DIE(431)
SET DUOUT=""
+4 QUIT
+5 ;
12 ;
+1 WRITE !!
+2 IF '$$DIE(900)
SET DUOUT=""
+3 QUIT
+4 ;
DIE(DR) ; --- Edit appropriate fields in Denial
+1 WRITE !!
+2 SET DA=ACHSA
+3 SET DA(1)=DUZ(2)
+4 SET DIE="^ACHSDEN("_DUZ(2)_",""D"","
+5 IF '$$LOCK^ACHS("^ACHSDEN(DUZ(2),""D"",ACHSA)","+")
QUIT 0
+6 DO ^DIE
+7 ;ACHS*3.1*13 8.31.06 IHS.OIT.FCJ ADDED CALL TO REF IN NXT LINE
+8 IF DR=431
DO APPEAL
DO REF
+9 IF '$$LOCK^ACHS("^ACHSDEN(DUZ(2),""D"",ACHSA)","-")
QUIT 0
+10 QUIT 1
APPEAL ;--ENTER OR EDIT APPEAL TRANSACTIONS--
+1 SET ACHSTREC=$PIECE(D,U,2)
+2 SET ACHSDREC=$PIECE(^ACHSDEN(DUZ(2),"D",ACHSA,400),U,3)
+3 ;S %=$$DIR^ACHS("Y","DO YOU WANT TO CHANGE THE DENIAL APPEAL STATUS","NO","By entering NO only the appeal status in the transaction record is changed.","","")
+4 ;I Y S $P(^ACHSDEN(DUZ(2),"D",ACHSA,400),U,3)=ACHSTREC
+5 ;
+6 ;ITSC-SET-JVK 5/27/03 ACHS*3.1*6
+7 IF ACHSDREC=""
SET $PIECE(^ACHSDEN(DUZ(2),"D",ACHSA,400),U,3)=ACHSTREC
+8 IF ACHSTREC=""
SET $PIECE(^ACHSDEN(DUZ(2),"D",ACHSA,400),U,3)=""
+9 IF ACHSDREC'=ACHSTREC
SET $PIECE(^ACHSDEN(DUZ(2),"D",ACHSA,400),U,3)=ACHSTREC
+10 SET %=$$DN^ACHS(400,3)
+11 IF %=""
SET $PIECE(ACHSDEN(DUZ(2),"D",ACHSA,0),U,8)=""
QUIT
+12 IF $$GET1^DIQ(9002074,%,.01,"I")="REVERSED AFTER APPEAL"
SET $PIECE(^ACHSDEN(DUZ(2),"D",ACHSA,0),U,8)="R"
+13 IF $$GET1^DIQ(9002074,%,.01,"I")="PAYED WITH ADDITIONAL MONEY"
SET $PIECE(^ACHSDEN(DUZ(2),"D",ACHSA,0),U,8)="R"
+14 IF $$GET1^DIQ(9002074,%,.01,"I")="APPEAL PENDING"
SET $PIECE(^ACHSDEN(DUZ(2),"D",ACHSA,0),U,8)=""
+15 IF $$GET1^DIQ(9002074,%,.01,"I")="UPHELD AFTER APPEAL"
SET $PIECE(^ACHSDEN(DUZ(2),"D",ACHSA,0),U,8)=""
+16 ;ACHS*3.1*13 8.31.06 IHS.OIT.FCJ
QUIT
+17 ;ACHS*3.1*13 8.31.06 IHS.OIT.FCJ ST OF CHANGES TO CALL INTERFACE W/RCIS
REF ;UPDATE REFERRAL IF DENIAL EXIST AND LINK IS ON
+1 ;GET REF IF DOES NOT EXIST WRITE ERROR MESSAGE WITH A RET TO CONT
+2 IF $$LINK^ACHSBMC
Begin DoDot:1
+3 SET ACHSREC=""
+4 SET ACHSREC=^ACHSDEN(DUZ(2),"D",ACHSA,431,D1,0)
DO APPEAL^ACHSBMC
+5 KILL ACHSREC
End DoDot:1
+6 QUIT
+7 ;ACHS*3.1*13 8.31.06 IHS.OIT.FCJ END OF CHANGES
