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

ACHSDADP.m

Go to the documentation of this file. 
  1. 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
  1.  ;ACHS*3.1.* 7/1/2003 NEW ROUTINE TO ENTER APPEAL STATUS
  1.  ;AND APPEAL LEVEL
  1.  ;ACHS*3.1*13 9.8.06 IHS/OIT/FCJ MISSING Q, SCREEN NOT UPDATING, ADDED
  1.  ;     INTERFACE TO RCIS REFERRAL
  1.  ;
  1.  K DFN S ACHDOCT="denial"
  1.  D ^ACHSDLK
  1.  I $D(ACHDLKER) D RTRN^ACHS Q
  1.  S DA=ACHSA
  1. TOF ;
  1.  Q:'$D(ACHSA)
  1.  Q:'$D(^ACHSDEN(DUZ(2),"D",ACHSA,0))
  1.  W @IOF
  1. DSP ; --- Display
  1.  D VIDEO^ACHS
  1.  S:'$D(IORVON) IORVON=""
  1.  S:'$D(IORVOFF) IORVOFF=""
  1.  D HDR,P1
  1.  G:'$D(DUOUT) TOF
  1. END ;
  1.  K ACHSI,ACHSJ,ACHSPRNF,ACHSPROF,ACHSMPRI
  1.  Q
  1.  ;
  1. HDR ;
  1.  S ACHDPAT=$S($$DN^ACHS(0,7):$P($G(^DPT($$DN^ACHS(0,7),0)),U),1:$$DN^ACHS(10,1))
  1.  W IORVON,!?79,!,"CHS DENIAL DISPLAY",?25,"PATIENT: ",$E(ACHDPAT,1,25),?62,"CHART#: "
  1.  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)
  1.  E  W "NONE"
  1.  W !?79,IORVOFF,!,$$REPEAT^XLFSTR("=",79),!
  1.  Q
  1.  ;
  1. P1 ; --- Display Page 1
  1.  W IORVOFF
  1.  S STATUS=$$DN^ACHS(0,8)
  1.  W "DENIAL NO: ",$$DN^ACHS(0,1),?45,"DENIAL STATUS: ",$S(STATUS="":"Active",STATUS="Y":"Canceled",STATUS="R":"Reversed"),!
  1.  W "DATE ISSUED: ",$$FMTE^XLFDT($$DN^ACHS(0,2))
  1.  W ?45,"ISSUED BY: ",$E($P($G(^VA(200,$$DN^ACHS(0,3),0)),U),1,25)
  1.  W !!,"1. DATE MED SVC: ",$$FMTE^XLFDT($$DN^ACHS(0,4))
  1.  W ?43,"2. DATE OF REQUEST: ",$$FMTE^XLFDT($$DN^ACHS(0,5))
  1.  ;ITSC/SET/JVK ACHS*3.1*6 MEDICAL PRIORITY ORIGNALLY NOT REQUIRED FIELD
  1.  S ACHSMPRI=$$DN^ACHS(400,2)
  1.  ;W !,"3. MEDICAL PRIORITY: ",$P($G(^ACHSMPRI($$DN^ACHS(400,2),0)),U)
  1.  W !,"3. MEDICAL PRIORITY: ",$S(ACHSMPRI'="":$P($G(^ACHSMPRI($$DN^ACHS(400,2),0)),U),ACHSMPRI="":"NONE SET")
  1.  S %=$$DN^ACHS(100,10)
  1.  ;
  1.  W !,"4. VISIT TYPE: ",$S(%="O":"OUTPATIENT",%="I":"INPATIENT",%="A":"AMBULANCE",%="P":"PATIENT ESCORT",%="D":"DENTAL",1:"UNKNOWN")
  1.  ;
  1.  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))
  1.  ;
  1.  W !,"6. SECONDARY PROVIDERS: "
  1.  ;--Other providers on file Node 200
  1.  S ACHSI=0
  1.  F ACHSJ=1:1:3  S ACHSI=$O(^ACHSDEN(DUZ(2),"D",ACHSA,200,ACHSI))  Q:ACHSI'?1N.N  D
  1.  . S ACHSPROF(ACHSJ)=$P(^ACHSDEN(DUZ(2),"D",ACHSA,200,ACHSI,0),U)
  1.  . S ACHSPROF(ACHSJ)=$P(^AUTTVNDR(ACHSPROF(ACHSJ),0),U)
  1.  . W ?25,ACHSPROF(ACHSJ),!
  1.  ;--Other providers not on file Node 210
  1.  S ACHSI=0
  1.  F ACHSJ=1:1:3  S ACHSI=$O(^ACHSDEN(DUZ(2),"D",ACHSA,210,ACHSI))  Q:ACHSI'?1N.N  D
  1.  . S ACHSPRNF(ACHSJ)=$P(^ACHSDEN(DUZ(2),"D",ACHSA,210,ACHSI,0),U)
  1.  . W ?25,ACHSPRNF(ACHSJ),!
  1.  ;
  1.  W !,"7. PRIMARY DENIAL REASON: " S %=$$DN^ACHS(250,1) I % W $P($G(^ACHSDENS(%,0)),U)
  1.  ;
  1.  W !,"8. *OTHER RESOURCES: ",$S($P($G(^ACHSDEN(DUZ(2),"D",ACHSA,800,0)),U,4):"YES",1:"NONE")
  1.  ;
  1.  W ?43,"9. *OTHER IHS RESOURCES: ",$S($P($G(^ACHSDEN(DUZ(2),"D",ACHSA,825,0)),U,4):"YES",1:"NONE")
  1.  ;
  1.  S %=$$DN^ACHS(400,3)
  1.  W !,"10. APPEAL STATUS: ",IORVON,$S(%'="":$P($G(^ACHSDENA(%,0)),U),1:"NONE"),IORVOFF
  1.  S %=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,431,0)),U,4)
  1.  W ?42,"11. *APPEAL TRANSACTION RECORDS: ",$S(%'="":$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,431,0)),U,4),1:"NONE")
  1.  W !,"12. *CHS OFFICE COMMENTS: ",$S($D(^ACHSDEN(DUZ(2),"D",ACHSA,900,0)):"YES",1:"NONE")
  1.  ;
  1.  W !?15,IORVON,"*",IORVOFF," - CHOOSE THESE FIELDS TO SEE FURTHER INFORMATION",!
  1.  ;
  1.  S %=$$DIR^ACHS("LO^8:12","Enter Number Of Field To Edit or <RETURN> To Accept","","","","")
  1.  ;
  1.  I %="" S DUOUT=""
  1.  Q:$D(DUOUT)!$D(DTOUT)!'%
  1.  D @(+%)
  1.  Q
  1.  ;
  1. 8 ; --- Other Resources
  1.  W !!
  1.  I '$$DIE(800) S DUOUT=""
  1.  Q
  1.  ;
  1.  ;'OTHER IHS RESOURCES'
  1. 9 ;
  1.  W !!
  1.  I '$$DIE(825) S DUOUT=""
  1.  Q
  1.  ;
  1. 10 ;
  1.  ;ITSC-SET-JVK 5/27/03 ACHS*3.1*6
  1.  ;I '$$DIE(430) S DUOUT=""
  1.  W @IOF
  1.  W ?20,"APPEAL TRANSACTION MENU",!
  1.  I '$$DIE(431) S DUOUT=""
  1.  Q
  1. 11 ;
  1.  W @IOF
  1.  W ?20,"APPEAL TRANSACTION MENU",!
  1.  I '$$DIE(431) S DUOUT=""
  1.  Q
  1.  ;
  1. 12 ;
  1.  W !!
  1.  I '$$DIE(900) S DUOUT=""
  1.  Q
  1.  ;
  1. DIE(DR) ; --- Edit appropriate fields in Denial
  1.  W !!
  1.  S DA=ACHSA
  1.  S DA(1)=DUZ(2)
  1.  S DIE="^ACHSDEN("_DUZ(2)_",""D"","
  1.  I '$$LOCK^ACHS("^ACHSDEN(DUZ(2),""D"",ACHSA)","+") Q 0
  1.  D ^DIE
  1.  ;ACHS*3.1*13 8.31.06 IHS.OIT.FCJ ADDED CALL TO REF IN NXT LINE
  1.  I DR=431 D APPEAL,REF
  1.  I '$$LOCK^ACHS("^ACHSDEN(DUZ(2),""D"",ACHSA)","-") Q 0
  1.  Q 1
  1. APPEAL ;--ENTER OR EDIT APPEAL TRANSACTIONS--
  1.  S ACHSTREC=$P(D,U,2)
  1.  S ACHSDREC=$P(^ACHSDEN(DUZ(2),"D",ACHSA,400),U,3)
  1.  ;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.","","")
  1.  ;I Y S $P(^ACHSDEN(DUZ(2),"D",ACHSA,400),U,3)=ACHSTREC
  1.  ;
  1.  ;ITSC-SET-JVK 5/27/03 ACHS*3.1*6
  1.  I ACHSDREC="" S $P(^ACHSDEN(DUZ(2),"D",ACHSA,400),U,3)=ACHSTREC
  1.  I ACHSTREC="" S $P(^ACHSDEN(DUZ(2),"D",ACHSA,400),U,3)=""
  1.  I ACHSDREC'=ACHSTREC S $P(^ACHSDEN(DUZ(2),"D",ACHSA,400),U,3)=ACHSTREC
  1.  S %=$$DN^ACHS(400,3)
  1.  I %="" S $P(ACHSDEN(DUZ(2),"D",ACHSA,0),U,8)="" Q
  1.  I $$GET1^DIQ(9002074,%,.01,"I")="REVERSED AFTER APPEAL" S $P(^ACHSDEN(DUZ(2),"D",ACHSA,0),U,8)="R"
  1.  I $$GET1^DIQ(9002074,%,.01,"I")="PAYED WITH ADDITIONAL MONEY" S $P(^ACHSDEN(DUZ(2),"D",ACHSA,0),U,8)="R"
  1.  I $$GET1^DIQ(9002074,%,.01,"I")="APPEAL PENDING" S $P(^ACHSDEN(DUZ(2),"D",ACHSA,0),U,8)=""
  1.  I $$GET1^DIQ(9002074,%,.01,"I")="UPHELD AFTER APPEAL" S $P(^ACHSDEN(DUZ(2),"D",ACHSA,0),U,8)=""
  1.  Q  ;ACHS*3.1*13 8.31.06 IHS.OIT.FCJ
  1.  ;ACHS*3.1*13 8.31.06 IHS.OIT.FCJ ST OF CHANGES TO CALL INTERFACE W/RCIS
  1. 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
  1.  I $$LINK^ACHSBMC D
  1.  .S ACHSREC=""
  1.  .S ACHSREC=^ACHSDEN(DUZ(2),"D",ACHSA,431,D1,0) D APPEAL^ACHSBMC
  1.  .K ACHSREC
  1.  Q
  1.  ;ACHS*3.1*13 8.31.06 IHS.OIT.FCJ END OF CHANGES