ACHSDN2A ;IHS/ITSC/PMF - DENIAL SET UP & DISPLAY ; [ 04/17/2002 2:08 PM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**3,4,18,19,21,22**;JUN 11, 2001;Build 43
;ACHS*3.1*3 handle 'Alternate resource available' special - ENTIRE ROUTINE IS NEW
;ACHS*3.1*4 remove blank spaces from an input
;ACHS*3.1*18 Request for type of insurance
;
;we get here if any of the reasons for this denial are
;Alternate Resource Available
;
;here we find out which alternate resource they mean
;
;ACHS*3.1*18 IHS/OIT/FCJ NEW SECTION FOR TYPE OF ALT RESOURCE
;ACHS*3.1*19 IHS/OIT.FCJ CHANGED ACHSCT TO ACHSOCT IN NXT SECTION
TYPPRI ;EP-ALT RES TYPE FOR PRIMARY REASON
;ACHS*3.1*22 ADDED A SLASH TO NXT LINE
I $P(^ACHSDENS($$DN^ACHS(250,1),20,ACHDROPT,0),U)["IHS/Tribal" D DICFAC I +ACHDFC I '$$DIE^ACHSDN("253////"_ACHDFC) Q ;ACHS*3.1*18
I ($P(^ACHSDENS($$DN^ACHS(250,1),20,ACHDROPT,0),U)["Eligible")!($P(^ACHSDENS($$DN^ACHS(250,1),20,ACHDROPT,0),U)["Failure") D
.S ACHSQUIT=0,ACHSOCT=0
.I $D(^ACHSDEN(DUZ(2),"D",ACHSA,256,"B")) S ACHSOCT=ACHSOCT+1
.F D Q:(ACHSOCT>0)&(ACHSQUIT=1)
..S Y=+$$ALTOPT(ACHDENR) I Y<0 S ACHSQUIT=1
..I Y>0,$D(^ACHSDEN(DUZ(2),"D",ACHSA,256,"B",+Y)) W !,"Alternate Resource Type Already entered" Q ;ACHS*3.1*21 NEW LINE
..I Y>0,$$DIE^ACHSDN("256///"_Y) S ACHSOCT=ACHSOCT+1,ACHSQUIT=0
..I ACHSOCT=0 W !,"You must enter a Alternate Resource Type."
G:$P(^ACHSDENS($$DN^ACHS(250,1),20,ACHDROPT,0),U)["Other" ALT ;ACHS*3.1*19 NOW TEST FOR OTHER BEFORE ASKING ALT
Q ;ACHS*3.1*19
;
TYPOTH ;EP-OTHER DENIAL REASON TYPE FOR ALT RES
I $P(^ACHSDENS(ACHDOTR,20,ACHDROPT,0),U)["IHS/Tribal" D DICFAC I +ACHDFC S $P(^ACHSDEN(DUZ(2),"D",ACHSA,300,ACHDORNM,0),U,3)=+ACHDFC ;ACHS*3.1*18
I ($P(^ACHSDENS(ACHDOTR,20,ACHDROPT,0),U)["Eligible")!($P(^ACHSDENS(ACHDOTR,20,ACHDROPT,0),U)["Failure") D
.S ACHSQUIT=0,ACHSOCT=0
.S ^ACHSDEN(DUZ(2),"D",ACHSA,300,ACHDORNM,4,0)="^9002071.44^0^0"
.S DA=0 F D Q:(ACHSOCT>0)&(ACHSQUIT=1)
..;S Y=+$$ALTOPT(ACHDOTR) I +Y>0 S ACHSOCT=ACHSOCT+1
..I $D(^ACHSDEN(DUZ(2),"D",ACHSA,300,ACHDORNM,4,"B")) S ACHSOCT=ACHSOCT+1
..S Y=+$$ALTOPT(ACHDOTR)
..I Y>0,$D(^ACHSDEN(DUZ(2),"D",ACHSA,300,ACHDORNM,4,"B",+Y)) W !,"Alternate Resource Type Already entered" Q ;ACHS*3.1*21
..I +Y>0 S ACHSOCT=ACHSOCT+1
..I ACHSOCT=0 W !,"You must enter an Alternate Resource Type." Q
..I +Y<0,ACHSOCT>0 S ACHSQUIT=1 Q ;ACHS*3.1*19
..S DA=DA+1
..S DIE="^ACHSDEN("_DUZ(2)_",""D"","_ACHSA_",300,"_ACHDORNM_",4,"
..S DA(3)=DUZ(2)
..S DA(2)=ACHSA
..S DA(1)=ACHDORNM
..S DR=".01///"_Y
..D ^DIE
..S $P(^ACHSDEN(DUZ(2),"D",ACHSA,300,ACHDORNM,4,0),U,3,4)=DA_"U"_DA
S ACHSQUIT=0
;;ACHS*3.1*18 IHS/OIT/FCJ END OF CHANGES
Q:$P(^ACHSDENS(ACHDOTR,20,ACHDROPT,0),U)'["Other" ;ACHS*3.1*19
ALT ;
;first of all, if this is not a registered patient, we
;can't do nothing here
I '$G(DFN) Q
;set up some vars, then call a routine that returns this patient's
;alternate resource info in array INS
S ACHSFDT=$G(ACHSFDT) I ACHSFDT="" S ACHSFDT=$G(ACHSDOS)
I $G(DFN) D GET^ACHSRPIN,PRT^ACHSRPIN
;
N OK,ZZ
D GETREC
;
;if any quit condition occured, stop. Or, if none chosen, stop.
I $D(DTOUT)!$D(DUOUT)!$G(ACHSQUIT)!'+Y Q
;
;if not quitting, then Y is a list of pointers to array INS,
;which is a list of resources. Get the resource pointers out of
;INS and record them.
;
N NUM
K ^ACHSDEN(DUZ(2),"D",ACHSA,320)
S ^ACHSDEN(DUZ(2),"D",ACHSA,320,0)=$$ZEROTH^ACHS(9002071,1,320)
F ZZ=1:1:$L(Y,",") D
. S NUM=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,320,0)),U,3)+1
. S ^ACHSDEN(DUZ(2),"D",ACHSA,320,NUM,0)=NUM_U_$P(INS($P(Y,",",ZZ)),U,7,9)
. S $P(^ACHSDEN(DUZ(2),"D",ACHSA,320,0),U,3,4)=NUM_U_NUM
. Q
;
Q
;
GETREC ;
W !!,"Enter the number(s) of the resources relevant to this denial.",!,"If more than one, separate with commas (1,2,3..): "
D READ^ACHSFU
I $D(DUOUT)!$D(DTOUT) Q
I Y="" Q
I Y?1N.N,(Y>0),(Y'>INS) Q
;
;ACHS*3.1*4 3/28/02 pmf get rid of blanks
S Y=$TR(Y," ") ; ACHS*3.1*4
;
S OK=1 F ZZ=1:1:$L(Y,",") S X=$P(Y,",",ZZ) D Q:'OK
. I X'?1N.N S OK=0 Q
. I X<1 S OK=0 Q
. I X>INS S OK=0 Q
. Q
I 'OK W " ??",! G GETREC
Q
;
ALTOPT(X,Y) ; --- Select ALT RES TYPE
I '$D(^ACHSDENS(X,30,0)) Q -1
N DIC
W !!
S DIC="^ACHSDENS("_X_",30,"
S DIC(0)="QAEMZ"
S DIC("A")="Enter "_$G(Y)_"Alternate Resource Type: "
S DA(1)=X
D ^DIC
Q Y
DICFAC ;EP FR ACHSDN4
N DIC
W !!
S ACHDFC="",DIC="^AUTTLOC(",DIC(0)="QAEM"
S DIC("A")="Enter the IHS/Tribal Facility that was available: "
D ^DIC S ACHDFC=+Y
G:Y<0 DICFAC
Q
ACHSDN2A ;IHS/ITSC/PMF - DENIAL SET UP & DISPLAY ; [ 04/17/2002 2:08 PM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**3,4,18,19,21,22**;JUN 11, 2001;Build 43
+2 ;ACHS*3.1*3 handle 'Alternate resource available' special - ENTIRE ROUTINE IS NEW
+3 ;ACHS*3.1*4 remove blank spaces from an input
+4 ;ACHS*3.1*18 Request for type of insurance
+5 ;
+6 ;we get here if any of the reasons for this denial are
+7 ;Alternate Resource Available
+8 ;
+9 ;here we find out which alternate resource they mean
+10 ;
+11 ;ACHS*3.1*18 IHS/OIT/FCJ NEW SECTION FOR TYPE OF ALT RESOURCE
+12 ;ACHS*3.1*19 IHS/OIT.FCJ CHANGED ACHSCT TO ACHSOCT IN NXT SECTION
TYPPRI ;EP-ALT RES TYPE FOR PRIMARY REASON
+1 ;ACHS*3.1*22 ADDED A SLASH TO NXT LINE
+2 ;ACHS*3.1*18
IF $PIECE(^ACHSDENS($$DN^ACHS(250,1),20,ACHDROPT,0),U)["IHS/Tribal"
DO DICFAC
IF +ACHDFC
IF '$$DIE^ACHSDN("253////"_ACHDFC)
QUIT
+3 IF ($PIECE(^ACHSDENS($$DN^ACHS(250,1),20,ACHDROPT,0),U)["Eligible")!($PIECE(^ACHSDENS($$DN^ACHS(250,1),20,ACHDROPT,0),U)["Failure")
Begin DoDot:1
+4 SET ACHSQUIT=0
SET ACHSOCT=0
+5 IF $DATA(^ACHSDEN(DUZ(2),"D",ACHSA,256,"B"))
SET ACHSOCT=ACHSOCT+1
+6 FOR
Begin DoDot:2
+7 SET Y=+$$ALTOPT(ACHDENR)
IF Y<0
SET ACHSQUIT=1
+8 ;ACHS*3.1*21 NEW LINE
IF Y>0
IF $DATA(^ACHSDEN(DUZ(2),"D",ACHSA,256,"B",+Y))
WRITE !,"Alternate Resource Type Already entered"
QUIT
+9 IF Y>0
IF $$DIE^ACHSDN("256///"_Y)
SET ACHSOCT=ACHSOCT+1
SET ACHSQUIT=0
+10 IF ACHSOCT=0
WRITE !,"You must enter a Alternate Resource Type."
End DoDot:2
IF (ACHSOCT>0)&(ACHSQUIT=1)
QUIT
End DoDot:1
+11 ;ACHS*3.1*19 NOW TEST FOR OTHER BEFORE ASKING ALT
IF $PIECE(^ACHSDENS($$DN^ACHS(250,1),20,ACHDROPT,0),U)["Other"
GOTO ALT
+12 ;ACHS*3.1*19
QUIT
+13 ;
TYPOTH ;EP-OTHER DENIAL REASON TYPE FOR ALT RES
+1 ;ACHS*3.1*18
IF $PIECE(^ACHSDENS(ACHDOTR,20,ACHDROPT,0),U)["IHS/Tribal"
DO DICFAC
IF +ACHDFC
SET $PIECE(^ACHSDEN(DUZ(2),"D",ACHSA,300,ACHDORNM,0),U,3)=+ACHDFC
+2 IF ($PIECE(^ACHSDENS(ACHDOTR,20,ACHDROPT,0),U)["Eligible")!($PIECE(^ACHSDENS(ACHDOTR,20,ACHDROPT,0),U)["Failure")
Begin DoDot:1
+3 SET ACHSQUIT=0
SET ACHSOCT=0
+4 SET ^ACHSDEN(DUZ(2),"D",ACHSA,300,ACHDORNM,4,0)="^9002071.44^0^0"
+5 SET DA=0
FOR
Begin DoDot:2
+6 ;S Y=+$$ALTOPT(ACHDOTR) I +Y>0 S ACHSOCT=ACHSOCT+1
+7 IF $DATA(^ACHSDEN(DUZ(2),"D",ACHSA,300,ACHDORNM,4,"B"))
SET ACHSOCT=ACHSOCT+1
+8 SET Y=+$$ALTOPT(ACHDOTR)
+9 ;ACHS*3.1*21
IF Y>0
IF $DATA(^ACHSDEN(DUZ(2),"D",ACHSA,300,ACHDORNM,4,"B",+Y))
WRITE !,"Alternate Resource Type Already entered"
QUIT
+10 IF +Y>0
SET ACHSOCT=ACHSOCT+1
+11 IF ACHSOCT=0
WRITE !,"You must enter an Alternate Resource Type."
QUIT
+12 ;ACHS*3.1*19
IF +Y<0
IF ACHSOCT>0
SET ACHSQUIT=1
QUIT
+13 SET DA=DA+1
+14 SET DIE="^ACHSDEN("_DUZ(2)_",""D"","_ACHSA_",300,"_ACHDORNM_",4,"
+15 SET DA(3)=DUZ(2)
+16 SET DA(2)=ACHSA
+17 SET DA(1)=ACHDORNM
+18 SET DR=".01///"_Y
+19 DO ^DIE
+20 SET $PIECE(^ACHSDEN(DUZ(2),"D",ACHSA,300,ACHDORNM,4,0),U,3,4)=DA_"U"_DA
End DoDot:2
IF (ACHSOCT>0)&(ACHSQUIT=1)
QUIT
End DoDot:1
+21 SET ACHSQUIT=0
+22 ;;ACHS*3.1*18 IHS/OIT/FCJ END OF CHANGES
+23 ;ACHS*3.1*19
IF $PIECE(^ACHSDENS(ACHDOTR,20,ACHDROPT,0),U)'["Other"
QUIT
ALT ;
+1 ;first of all, if this is not a registered patient, we
+2 ;can't do nothing here
+3 IF '$GET(DFN)
QUIT
+4 ;set up some vars, then call a routine that returns this patient's
+5 ;alternate resource info in array INS
+6 SET ACHSFDT=$GET(ACHSFDT)
IF ACHSFDT=""
SET ACHSFDT=$GET(ACHSDOS)
+7 IF $GET(DFN)
DO GET^ACHSRPIN
DO PRT^ACHSRPIN
+8 ;
+9 NEW OK,ZZ
+10 DO GETREC
+11 ;
+12 ;if any quit condition occured, stop. Or, if none chosen, stop.
+13 IF $DATA(DTOUT)!$DATA(DUOUT)!$GET(ACHSQUIT)!'+Y
QUIT
+14 ;
+15 ;if not quitting, then Y is a list of pointers to array INS,
+16 ;which is a list of resources. Get the resource pointers out of
+17 ;INS and record them.
+18 ;
+19 NEW NUM
+20 KILL ^ACHSDEN(DUZ(2),"D",ACHSA,320)
+21 SET ^ACHSDEN(DUZ(2),"D",ACHSA,320,0)=$$ZEROTH^ACHS(9002071,1,320)
+22 FOR ZZ=1:1:$LENGTH(Y,",")
Begin DoDot:1
+23 SET NUM=$PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,320,0)),U,3)+1
+24 SET ^ACHSDEN(DUZ(2),"D",ACHSA,320,NUM,0)=NUM_U_$PIECE(INS($PIECE(Y,",",ZZ)),U,7,9)
+25 SET $PIECE(^ACHSDEN(DUZ(2),"D",ACHSA,320,0),U,3,4)=NUM_U_NUM
+26 QUIT
End DoDot:1
+27 ;
+28 QUIT
+29 ;
GETREC ;
+1 WRITE !!,"Enter the number(s) of the resources relevant to this denial.",!,"If more than one, separate with commas (1,2,3..): "
+2 DO READ^ACHSFU
+3 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+4 IF Y=""
QUIT
+5 IF Y?1N.N
IF (Y>0)
IF (Y'>INS)
QUIT
+6 ;
+7 ;ACHS*3.1*4 3/28/02 pmf get rid of blanks
+8 ; ACHS*3.1*4
SET Y=$TRANSLATE(Y," ")
+9 ;
+10 SET OK=1
FOR ZZ=1:1:$LENGTH(Y,",")
SET X=$PIECE(Y,",",ZZ)
Begin DoDot:1
+11 IF X'?1N.N
SET OK=0
QUIT
+12 IF X<1
SET OK=0
QUIT
+13 IF X>INS
SET OK=0
QUIT
+14 QUIT
End DoDot:1
IF 'OK
QUIT
+15 IF 'OK
WRITE " ??",!
GOTO GETREC
+16 QUIT
+17 ;
ALTOPT(X,Y) ; --- Select ALT RES TYPE
+1 IF '$DATA(^ACHSDENS(X,30,0))
QUIT -1
+2 NEW DIC
+3 WRITE !!
+4 SET DIC="^ACHSDENS("_X_",30,"
+5 SET DIC(0)="QAEMZ"
+6 SET DIC("A")="Enter "_$GET(Y)_"Alternate Resource Type: "
+7 SET DA(1)=X
+8 DO ^DIC
+9 QUIT Y
DICFAC ;EP FR ACHSDN4
+1 NEW DIC
+2 WRITE !!
+3 SET ACHDFC=""
SET DIC="^AUTTLOC("
SET DIC(0)="QAEM"
+4 SET DIC("A")="Enter the IHS/Tribal Facility that was available: "
+5 DO ^DIC
SET ACHDFC=+Y
+6 IF Y<0
GOTO DICFAC
+7 QUIT
