ACHSDNL4 ; IHS/ITSC/PMF - DENIAL LTR/FS (FS1) (5/6) ;7/27/10 16:17
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**3,14,18,23**;JUN 11,2001;Build 43
;ACHS*3.1*3 change chart number display
;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES
;ACHS*3.1*18 4/1/2010;IHS/OIT/ABK;Change every occurrance of Deferred to Unmet Need
;
START ;
D CPI^ACHS ;CONFIDENTIAL INFO MESSAGE
;{ABK, 4/2/10}W !!,$$C^ACHS("CHS DENIAL/DEFERRED SERVICES",80),!,$$C^ACHS("DENIAL FACT SHEET",80),!,$$REPEAT^XLFSTR("=",79),!,$$C^ACHS("Document number: "_$$DN^ACHS(0,1),80),!,$$REPEAT^XLFSTR("-",79),!
W !!,$$C^ACHS("CHS DENIAL",80),!,$$C^ACHS("DENIAL FACT SHEET",80),!,$$REPEAT^XLFSTR("=",79),!,$$C^ACHS("Document number: "_$$DN^ACHS(0,1),80),!,$$REPEAT^XLFSTR("-",79),!
;
G NOT:$$DN^ACHS(0,6)="N" ;PATIENT NOT REGISTERED
S DFN=$$DN^ACHS(0,7) ;PATIENT POINTER
I DFN']"" D END Q
I '$D(^DPT(DFN,0)) D END Q
;
S ACHDNAME=$P($G(^DPT(DFN,0)),U)
S ACHDNAME=$P(ACHDNAME,",",2,99)_" "_$P(ACHDNAME,",")
;
;11/29/01 pmf special data needed at the Pawnee facility.
;W ?4,ACHDNAME,?35,"CHART #: " W:$D(^AUPNPAT(DFN,41,DUZ(2),0)) $P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)," ",$P($G(^DIC(4,DUZ(2),0)),U) W:'$D(^DIC(4,DUZ(2),0)) "(No Chart At This Facility)" W ! ; ACHS*3.1*3
W ?4,ACHDNAME ; ACHS*3.1*3
D SETCHT^ACHSDNL2 ; ACHS*3.1*3
W ?35,ACHDCH,! ; ACHS*3.1*3
;
;
S A=$G(^DPT(DFN,.11))
W ?4,$P(A,U),!?4,$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 DATE
;
NOT ;
;1/8/02 pmf dont go date, quit instead
;I '$D(^ACHSDEN(DUZ(2),"D",ACHSA,10)) W "(No patient on file)" G DATE ; ACHS*3.1*3
I '$D(^ACHSDEN(DUZ(2),"D",ACHSA,10)) W "(No patient on file)" Q ; ACHS*3.1*3
;
S X=$G(^ACHSDEN(DUZ(2),"D",ACHSA,10))
S Y=$$DN^ACHS(10,1)
W ?4,$P(Y,",",2,99)
W:$P(Y,",",2,99)'="" " "
W $P(Y,","),?35,"CHART #: ",$S($P(X,U,6)]"":$P(X,U,6),1:"(No Chart At This Facility)"),!?4,$P(X,U,2),!?4,$P(X,U,3)
S ACHDST=$P(X,U,4)
I ACHDST]"",$D(^DIC(5,ACHDST,0)) W " ",$P($G(^DIC(5,ACHDST,0)),U,2)
W " ",$P(X,U,5),!!
DATE ;
S ACHSUMET=1
W !,"DATE OF SERVICES: ",$$FMTE^XLFDT($$DN^ACHS(0,4)),".",!," REQUEST MADE TO: ",$P($G(^DIC(4,DUZ(2),0)),U),!,"DATE REQUEST REC: ",$$FMTE^XLFDT($$DN^ACHS(0,5))
;
APPEAL ;
I $$DN^ACHS(400,3) W !," APPEAL STATUS: ",$P($G(^ACHSDENA($$DN^ACHS(400,3),0)),U)
TYPE ;
S X=$$DN^ACHS(100,10)
I $L(X) W !," TYPE OF SERVICE: " S Y=$P($G(^DD(9002071.01,110,0)),U,3) F %=1:1 D Q:'%
. I $P(Y,";",%)="" W "<unknown>" S %=0 Q
. I $P($P(Y,";",%),":")=X W $P($P(Y,";",%),":",2) S %=0 Q
;
PRIOR ; --- Medical Priority
I $$DN^ACHS(400,2) W !," PRIORITY: ",$P($G(^ACHSMPRI($$DN^ACHS(400,2),0)),U)
W !," DATE OF ISSUE: ",$$FMTE^XLFDT($$DN^ACHS(0,2)),!," ISSUED BY: "
S X=$$DN^ACHS(0,3)
I X W $P($G(^VA(200,X,0)),U)
W !,$$REPEAT^XLFSTR("-",79),!,$$C^ACHS("DENIAL REASON(S)",80)
S ACHDPDR=0,X=$$DN^ACHS(250,1)
I X W !!,"PRIMARY DENIAL REASON: ",$P($G(^ACHSDENS(X,0),"UNDEFINED"),U) S ACHDPDR=1
I $D(^ACHSDEN(DUZ(2),"D",ACHSA,300,0)),$P($G(^(0)),U,4)>0 G R1
I 'ACHDPDR W !,$S(ACHSUMET=1:"(No reasons on file)",1:"UN-MET NEED") G RLINE
R1 ;
;new var reason pointer
N RSNPTR
F X=0:0 S X=$O(^ACHSDEN(DUZ(2),"D",ACHSA,300,X)) Q:'X D
. S RSNPTR=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,300,X,0)),U)
. I RSNPTR="" Q
. W !,?23,$P($G(^ACHSDENS(RSNPTR,0)),U)
. Q
;
RLINE ;
;
G DLINE:"OI"'[$$DN^ACHS(100,10)
W !,$$REPEAT^XLFSTR("-",79),!," TYPE CODE",?20,"DIAGNOSIS"
;
I '$D(^ACHSDEN(DUZ(2),"D",ACHSA,700,0)),'$D(^ACHSDEN(DUZ(2),"D",ACHSA,500,0)) W "(No diagnosis on file)" G COMMENT
;
I $D(^ACHSDEN(DUZ(2),"D",ACHSA,500,0)) F DX=0:0 S DX=$O(^ACHSDEN(DUZ(2),"D",ACHSA,500,DX)) Q:+DX=0 D
.;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 4 LINES
.;S Y=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,500,X,0)),U) I Y]"",$D(^ICD9(Y,0)) W !,"(ICD9) ",$P($G(^ICD9(Y,0)),U),?20,$P($G(^ICD9(Y,0)),U,3)
.S DY=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,500,DX,0)),U)
.;ACHS*3.1*23 MOD NXT LINE ICD9 TO ICD AND ADDED $E
.I DY]"",$D(^ICD9(DY,0)) W !,"(ICD) ",$P($$ICDDX^ICDEX(DY,$$DN^ACHS(0,4),,"I"),U,2),?20,$E($P($$ICDDX^ICDEX(DY,$$DN^ACHS(0,4),,"I"),U,4),1,60)
;
I $D(^ACHSDEN(DUZ(2),"D",ACHSA,700,0)) F DX=0:0 S DX=$O(^ACHSDEN(DUZ(2),"D",ACHSA,700,DX)) Q:+DX=0 D
.;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 2 LINES
.;S Y=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,700,X,0)),U) I Y]"",$D(^ICPT(Y,0)) W !,"(CPT) ",$P($G(^ICPT(Y,0)),U),?20,$P($G(^ICPT(Y,0)),U,2)
.S DY=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,700,DX,0)),U) I DY]"",$D(^ICPT(DY,0)) W !,"(CPT) ",$P($$CPT^ICPTCOD(DY),U,2),?20,$P($$CPT^ICPTCOD(DY),U,3)
DLINE ;
W !,$$REPEAT^XLFSTR("-",79),!
G ^ACHSDNL5
;
END ;
D END^ACHSDNL5
Q
;
ACHSDNL4 ; IHS/ITSC/PMF - DENIAL LTR/FS (FS1) (5/6) ;7/27/10 16:17
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**3,14,18,23**;JUN 11,2001;Build 43
+2 ;ACHS*3.1*3 change chart number display
+3 ;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES
+4 ;ACHS*3.1*18 4/1/2010;IHS/OIT/ABK;Change every occurrance of Deferred to Unmet Need
+5 ;
START ;
+1 ;CONFIDENTIAL INFO MESSAGE
DO CPI^ACHS
+2 ;{ABK, 4/2/10}W !!,$$C^ACHS("CHS DENIAL/DEFERRED SERVICES",80),!,$$C^ACHS("DENIAL FACT SHEET",80),!,$$REPEAT^XLFSTR("=",79),!,$$C^ACHS("Document number: "_$$DN^ACHS(0,1),80),!,$$REPEAT^XLFSTR("-",79),!
+3 WRITE !!,$$C^ACHS("CHS DENIAL",80),!,$$C^ACHS("DENIAL FACT SHEET",80),!,$$REPEAT^XLFSTR("=",79),!,$$C^ACHS("Document number: "_$$DN^ACHS(0,1),80),!,$$REPEAT^XLFSTR("-",79),!
+4 ;
+5 ;PATIENT NOT REGISTERED
IF $$DN^ACHS(0,6)="N"
GOTO NOT
+6 ;PATIENT POINTER
SET DFN=$$DN^ACHS(0,7)
+7 IF DFN']""
DO END
QUIT
+8 IF '$DATA(^DPT(DFN,0))
DO END
QUIT
+9 ;
+10 SET ACHDNAME=$PIECE($GET(^DPT(DFN,0)),U)
+11 SET ACHDNAME=$PIECE(ACHDNAME,",",2,99)_" "_$PIECE(ACHDNAME,",")
+12 ;
+13 ;11/29/01 pmf special data needed at the Pawnee facility.
+14 ;W ?4,ACHDNAME,?35,"CHART #: " W:$D(^AUPNPAT(DFN,41,DUZ(2),0)) $P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)," ",$P($G(^DIC(4,DUZ(2),0)),U) W:'$D(^DIC(4,DUZ(2),0)) "(No Chart At This Facility)" W ! ; ACHS*3.1*3
+15 ; ACHS*3.1*3
WRITE ?4,ACHDNAME
+16 ; ACHS*3.1*3
DO SETCHT^ACHSDNL2
+17 ; ACHS*3.1*3
WRITE ?35,ACHDCH,!
+18 ;
+19 ;
+20 SET A=$GET(^DPT(DFN,.11))
+21 WRITE ?4,$PIECE(A,U),!?4,$PIECE(A,U,4)
+22 SET ACHDST=$PIECE(A,U,5)
+23 IF ACHDST]""
IF $DATA(^DIC(5,ACHDST,0))
WRITE " ",$PIECE($GET(^DIC(5,ACHDST,0)),U,2)
+24 WRITE " ",$PIECE(A,U,6),!!
+25 GOTO DATE
+26 ;
NOT ;
+1 ;1/8/02 pmf dont go date, quit instead
+2 ;I '$D(^ACHSDEN(DUZ(2),"D",ACHSA,10)) W "(No patient on file)" G DATE ; ACHS*3.1*3
+3 ; ACHS*3.1*3
IF '$DATA(^ACHSDEN(DUZ(2),"D",ACHSA,10))
WRITE "(No patient on file)"
QUIT
+4 ;
+5 SET X=$GET(^ACHSDEN(DUZ(2),"D",ACHSA,10))
+6 SET Y=$$DN^ACHS(10,1)
+7 WRITE ?4,$PIECE(Y,",",2,99)
+8 IF $PIECE(Y,",",2,99)'=""
WRITE " "
+9 WRITE $PIECE(Y,","),?35,"CHART #: ",$SELECT($PIECE(X,U,6)]"":$PIECE(X,U,6),1:"(No Chart At This Facility)"),!?4,$PIECE(X,U,2),!?4,$PIECE(X,U,3)
+10 SET ACHDST=$PIECE(X,U,4)
+11 IF ACHDST]""
IF $DATA(^DIC(5,ACHDST,0))
WRITE " ",$PIECE($GET(^DIC(5,ACHDST,0)),U,2)
+12 WRITE " ",$PIECE(X,U,5),!!
DATE ;
+1 SET ACHSUMET=1
+2 WRITE !,"DATE OF SERVICES: ",$$FMTE^XLFDT($$DN^ACHS(0,4)),".",!," REQUEST MADE TO: ",$PIECE($GET(^DIC(4,DUZ(2),0)),U),!,"DATE REQUEST REC: ",$$FMTE^XLFDT($$DN^ACHS(0,5))
+3 ;
APPEAL ;
+1 IF $$DN^ACHS(400,3)
WRITE !," APPEAL STATUS: ",$PIECE($GET(^ACHSDENA($$DN^ACHS(400,3),0)),U)
TYPE ;
+1 SET X=$$DN^ACHS(100,10)
+2 IF $LENGTH(X)
WRITE !," TYPE OF SERVICE: "
SET Y=$PIECE($GET(^DD(9002071.01,110,0)),U,3)
FOR %=1:1
Begin DoDot:1
+3 IF $PIECE(Y,";",%)=""
WRITE "<unknown>"
SET %=0
QUIT
+4 IF $PIECE($PIECE(Y,";",%),":")=X
WRITE $PIECE($PIECE(Y,";",%),":",2)
SET %=0
QUIT
End DoDot:1
IF '%
QUIT
+5 ;
PRIOR ; --- Medical Priority
+1 IF $$DN^ACHS(400,2)
WRITE !," PRIORITY: ",$PIECE($GET(^ACHSMPRI($$DN^ACHS(400,2),0)),U)
+2 WRITE !," DATE OF ISSUE: ",$$FMTE^XLFDT($$DN^ACHS(0,2)),!," ISSUED BY: "
+3 SET X=$$DN^ACHS(0,3)
+4 IF X
WRITE $PIECE($GET(^VA(200,X,0)),U)
+5 WRITE !,$$REPEAT^XLFSTR("-",79),!,$$C^ACHS("DENIAL REASON(S)",80)
+6 SET ACHDPDR=0
SET X=$$DN^ACHS(250,1)
+7 IF X
WRITE !!,"PRIMARY DENIAL REASON: ",$PIECE($GET(^ACHSDENS(X,0),"UNDEFINED"),U)
SET ACHDPDR=1
+8 IF $DATA(^ACHSDEN(DUZ(2),"D",ACHSA,300,0))
IF $PIECE($GET(^(0)),U,4)>0
GOTO R1
+9 IF 'ACHDPDR
WRITE !,$SELECT(ACHSUMET=1:"(No reasons on file)",1:"UN-MET NEED")
GOTO RLINE
R1 ;
+1 ;new var reason pointer
+2 NEW RSNPTR
+3 FOR X=0:0
SET X=$ORDER(^ACHSDEN(DUZ(2),"D",ACHSA,300,X))
IF 'X
QUIT
Begin DoDot:1
+4 SET RSNPTR=$PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,300,X,0)),U)
+5 IF RSNPTR=""
QUIT
+6 WRITE !,?23,$PIECE($GET(^ACHSDENS(RSNPTR,0)),U)
+7 QUIT
End DoDot:1
+8 ;
RLINE ;
+1 ;
+2 IF "OI"'[$$DN^ACHS(100,10)
GOTO DLINE
+3 WRITE !,$$REPEAT^XLFSTR("-",79),!," TYPE CODE",?20,"DIAGNOSIS"
+4 ;
+5 IF '$DATA(^ACHSDEN(DUZ(2),"D",ACHSA,700,0))
IF '$DATA(^ACHSDEN(DUZ(2),"D",ACHSA,500,0))
WRITE "(No diagnosis on file)"
GOTO COMMENT
+6 ;
+7 IF $DATA(^ACHSDEN(DUZ(2),"D",ACHSA,500,0))
FOR DX=0:0
SET DX=$ORDER(^ACHSDEN(DUZ(2),"D",ACHSA,500,DX))
IF +DX=0
QUIT
Begin DoDot:1
+8 ;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 4 LINES
+9 ;S Y=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,500,X,0)),U) I Y]"",$D(^ICD9(Y,0)) W !,"(ICD9) ",$P($G(^ICD9(Y,0)),U),?20,$P($G(^ICD9(Y,0)),U,3)
+10 SET DY=$PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,500,DX,0)),U)
+11 ;ACHS*3.1*23 MOD NXT LINE ICD9 TO ICD AND ADDED $E
+12 IF DY]""
IF $DATA(^ICD9(DY,0))
WRITE !,"(ICD) ",$PIECE($$ICDDX^ICDEX(DY,$$DN^ACHS(0,4),,"I"),U,2),?20,$EXTRACT($PIECE($$ICDDX^ICDEX(DY,$$DN^ACHS(0,4),,"I"),U,4),1,60)
End DoDot:1
+13 ;
+14 IF $DATA(^ACHSDEN(DUZ(2),"D",ACHSA,700,0))
FOR DX=0:0
SET DX=$ORDER(^ACHSDEN(DUZ(2),"D",ACHSA,700,DX))
IF +DX=0
QUIT
Begin DoDot:1
+15 ;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 2 LINES
+16 ;S Y=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,700,X,0)),U) I Y]"",$D(^ICPT(Y,0)) W !,"(CPT) ",$P($G(^ICPT(Y,0)),U),?20,$P($G(^ICPT(Y,0)),U,2)
+17 SET DY=$PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,700,DX,0)),U)
IF DY]""
IF $DATA(^ICPT(DY,0))
WRITE !,"(CPT) ",$PIECE($$CPT^ICPTCOD(DY),U,2),?20,$PIECE($$CPT^ICPTCOD(DY),U,3)
End DoDot:1
DLINE ;
+1 WRITE !,$$REPEAT^XLFSTR("-",79),!
+2 GOTO ^ACHSDNL5
+3 ;
END ;
+1 DO END^ACHSDNL5
+2 QUIT
+3 ;
