Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACHSDN2A

ACHSDN2A.m

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