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

ACHSDNL4.m

Go to the documentation of this file. 
  1. 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
  1.  ;ACHS*3.1*3  change chart number display
  1.  ;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES
  1.  ;ACHS*3.1*18 4/1/2010;IHS/OIT/ABK;Change every occurrance of Deferred to Unmet Need
  1.  ;
  1. START ;
  1.  D CPI^ACHS    ;CONFIDENTIAL INFO MESSAGE
  1.  ;{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),!
  1.  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),!
  1.  ;
  1.  G NOT:$$DN^ACHS(0,6)="N"          ;PATIENT NOT REGISTERED
  1.  S DFN=$$DN^ACHS(0,7)              ;PATIENT POINTER
  1.  I DFN']"" D END Q
  1.  I '$D(^DPT(DFN,0)) D END Q
  1.  ;
  1.  S ACHDNAME=$P($G(^DPT(DFN,0)),U)
  1.  S ACHDNAME=$P(ACHDNAME,",",2,99)_" "_$P(ACHDNAME,",")
  1.  ;
  1.  ;11/29/01  pmf  special data needed at the Pawnee facility.
  1.  ;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
  1.  W ?4,ACHDNAME  ; ACHS*3.1*3
  1.  D SETCHT^ACHSDNL2  ; ACHS*3.1*3
  1.  W ?35,ACHDCH,!  ; ACHS*3.1*3
  1.  ;
  1.  ;
  1.  S A=$G(^DPT(DFN,.11))
  1.  W ?4,$P(A,U),!?4,$P(A,U,4)
  1.  S ACHDST=$P(A,U,5)
  1.  I ACHDST]"",$D(^DIC(5,ACHDST,0)) W " ",$P($G(^DIC(5,ACHDST,0)),U,2)
  1.  W " ",$P(A,U,6),!!
  1.  G DATE
  1.  ;
  1. NOT ;
  1.  ;1/8/02  pmf  dont go date, quit instead
  1.  ;I '$D(^ACHSDEN(DUZ(2),"D",ACHSA,10)) W "(No patient on file)" G DATE  ; ACHS*3.1*3
  1.  I '$D(^ACHSDEN(DUZ(2),"D",ACHSA,10)) W "(No patient on file)" Q  ; ACHS*3.1*3
  1.  ;
  1.  S X=$G(^ACHSDEN(DUZ(2),"D",ACHSA,10))
  1.  S Y=$$DN^ACHS(10,1)
  1.  W ?4,$P(Y,",",2,99)
  1.  W:$P(Y,",",2,99)'="" " "
  1.  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)
  1.  S ACHDST=$P(X,U,4)
  1.  I ACHDST]"",$D(^DIC(5,ACHDST,0)) W " ",$P($G(^DIC(5,ACHDST,0)),U,2)
  1.  W " ",$P(X,U,5),!!
  1. DATE ;
  1.  S ACHSUMET=1
  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))
  1.  ;
  1. APPEAL ;
  1.  I $$DN^ACHS(400,3) W !,"   APPEAL STATUS: ",$P($G(^ACHSDENA($$DN^ACHS(400,3),0)),U)
  1. TYPE ;
  1.  S X=$$DN^ACHS(100,10)
  1.  I $L(X) W !," TYPE OF SERVICE: " S Y=$P($G(^DD(9002071.01,110,0)),U,3) F %=1:1 D  Q:'%
  1.  . I $P(Y,";",%)="" W "<unknown>" S %=0 Q
  1.  . I $P($P(Y,";",%),":")=X W $P($P(Y,";",%),":",2) S %=0 Q
  1.  ;
  1. PRIOR ; --- Medical Priority
  1.  I $$DN^ACHS(400,2) W !,"        PRIORITY: ",$P($G(^ACHSMPRI($$DN^ACHS(400,2),0)),U)
  1.  W !,"   DATE OF ISSUE: ",$$FMTE^XLFDT($$DN^ACHS(0,2)),!,"       ISSUED BY: "
  1.  S X=$$DN^ACHS(0,3)
  1.  I X W $P($G(^VA(200,X,0)),U)
  1.  W !,$$REPEAT^XLFSTR("-",79),!,$$C^ACHS("DENIAL REASON(S)",80)
  1.  S ACHDPDR=0,X=$$DN^ACHS(250,1)
  1.  I X W !!,"PRIMARY DENIAL REASON: ",$P($G(^ACHSDENS(X,0),"UNDEFINED"),U) S ACHDPDR=1
  1.  I $D(^ACHSDEN(DUZ(2),"D",ACHSA,300,0)),$P($G(^(0)),U,4)>0 G R1
  1.  I 'ACHDPDR W !,$S(ACHSUMET=1:"(No reasons on file)",1:"UN-MET NEED") G RLINE
  1. R1 ;
  1.  ;new var reason pointer
  1.  N RSNPTR
  1.  F X=0:0 S X=$O(^ACHSDEN(DUZ(2),"D",ACHSA,300,X)) Q:'X  D
  1.  . S RSNPTR=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,300,X,0)),U)
  1.  . I RSNPTR="" Q
  1.  . W !,?23,$P($G(^ACHSDENS(RSNPTR,0)),U)
  1.  . Q
  1.  ;
  1. RLINE ;
  1.  ;
  1.  G DLINE:"OI"'[$$DN^ACHS(100,10)
  1.  W !,$$REPEAT^XLFSTR("-",79),!," TYPE    CODE",?20,"DIAGNOSIS"
  1.  ;
  1.  I '$D(^ACHSDEN(DUZ(2),"D",ACHSA,700,0)),'$D(^ACHSDEN(DUZ(2),"D",ACHSA,500,0)) W "(No diagnosis on file)" G COMMENT
  1.  ;
  1.  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
  1.  .;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 4 LINES
  1.  .;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)
  1.  .S DY=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,500,DX,0)),U)
  1.  .;ACHS*3.1*23 MOD NXT LINE ICD9 TO ICD AND ADDED $E
  1.  .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)
  1.  ;
  1.  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
  1.  .;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 2 LINES
  1.  .;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)
  1.  .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)
  1. COMMENT ;
  1. DLINE ;
  1.  W !,$$REPEAT^XLFSTR("-",79),!
  1.  G ^ACHSDNL5
  1.  ;
  1. END ;
  1.  D END^ACHSDNL5
  1.  Q
  1.  ;