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

ACHSDLK.m

Go to the documentation of this file. 
  1. ACHSDLK ; IHS/ITSC/PMF - DENIAL LOOKUP ;  [ 10/31/2003  11:41 AM ]
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUNE 11, 2001
  1.  ;ACHS*3.1*1 expand prompt for denial number to include patient name
  1.  ;ACHS*3.1*3 added search for non registered patients
  1.  ;           Overhauled routine structure so that THIS ALL LOOKS NEW
  1.  ;ACHS*3.1*4 include issue and service dates on line display
  1.  ;ACHS*3.1*6 3.28.03 IHS/SET/FCJ Not able to look up non reg patients
  1.  ;           format problems on display
  1.  ;
  1.  ;12/20/01   pmf
  1.  ;I have saved off this routine to ACHSDLKS if we need to roll back or
  1.  ;check against the previous version.
  1.  ;
  1.  ;
  1.  K ACHDLKER,DFN
  1.  S DIWL=5,DIWR=75,DIWF="W"
  1.  N DONE S DONE=0
  1.  ;
  1.  ;keep asking them for a denial until we get DONE
  1.  ;DONE can mean we got one, or we are ready to quit
  1.  F  D  Q:DONE
  1.  . D GETDEN
  1.  . I $D(ACHDLKER) S DONE=1 Q
  1.  . I ACHSA="" S (ACHDLKER,DONE)=1 Q
  1.  . D PP
  1.  . Q
  1.  ;
  1.  K DIC
  1.  Q
  1.  ;
  1.  ;
  1. GETDEN ;get a denial, either by number or by patient
  1.  W !!
  1.  K DFN,DIC,Y S ACHSA=""
  1.  S DIR("A")="Enter the DENIAL NUMBER or PATIENT"
  1.  S DIR("?")="Enter either the denial number or a Patient Identifier (Name, HRN, SSN, DOB)"
  1.  S DIR(0)="FO" D ^DIR K DIR
  1.  ;
  1.  ;now the responses.  if quit, quit.
  1.  Q:$D(DIRUT)
  1.  ;
  1.  ;see if the input is a real, full denial case number
  1.  ;if so, X will not be null after this
  1.  S X="",X=$O(^ACHSDEN(DUZ(2),"D","B",Y,""))
  1.  ;
  1.  ;if they entered a blank space or a denial number, use
  1.  ;^DIC to load info
  1.  I Y=" "!X S X="" D GETDEN2("EMZ",Y) Q:ACHSA'=""  W "  ","??" G GETDEN
  1.  ;
  1.  ;ACHS*3.1*6 3.28.03 IHS/SET/FCJ ADD NXT 4 LINES TO LST DENIAL PATIENTS 
  1.  ;Registered and non-registered
  1.  S X=Y,ACHSTMP=Y ;SAVE VAR FOR RETURN FR GETDEN2
  1.  I X'?1N.N D GETDEN2("EMZ",X)
  1.  I $D(DTOUT)!$D(DUOUT) G GETDEN
  1.  Q:ACHSA'=""
  1.  ;
  1.  ;first, try patient lookup for registered patients
  1.  ;ACHS*3.1*6 3.28.03 IHS/SET/FCJ Y VALUE WAS CHANGED IN CALL TO GETDEN
  1.  ;S X=Y,DIC="^AUPNPAT(",DIC(0)="EM",AUPNLK("ALL")=1 ;ACHS*3.1*6
  1.  S X=ACHSTMP,DIC="^AUPNPAT(",DIC(0)="EM",AUPNLK("ALL")=1 ;ACHS*3.1*6
  1.  D ^DIC
  1.  ;
  1.  ;if that didn't work, try looking up unregistered patients
  1.  ;if it works, stop, if it doesn't go back to the top
  1.  I +Y<0 D  Q:ACHSA'=""  W "  ","??" G GETDEN
  1.  . D GETDEN2("EMZ",X)
  1.  . ;I +Y<1 S ACHDLKER="" G END
  1.  . ;S ACHSA=+Y
  1.  ;
  1.  ;if we DID find a registered patient, submit that and get denial
  1.  S PATDAT=$G(^DPT(+Y,0))
  1.  I PATDAT="" G GETDEN
  1.  D GETDEN2("EMZ",$P(PATDAT,U,1))
  1.  I +Y<0 W "  ","??" G GETDEN
  1.  S ACHSA=+Y
  1.  ;
  1.  K ACHSTMP ;ACHS*3.1*6 3.28.03 IHS/SET/FCJ ADDED K ACHSTMP
  1.  Q
  1.  ;
  1. GETDEN2(DIC0,X) ;
  1.  ;use ^DIC to get a denial case.
  1.  ;input:   DIC0   the value to give DIC(0)
  1.  ;         X      the input value for ^DIC, not manditory
  1.  S X=$G(X)
  1.  K DIC
  1.  S DIC="^ACHSDEN("_DUZ(2)_",""D"","
  1.  S DIC(0)=DIC0
  1.  S DIC("A")="Enter the DENIAL NUMBER or PATIENT: "
  1.  S DIC("S")="I $P($G(^(0)),U)'[""#"""
  1.  S DA(1)=DUZ(2)
  1.  ;
  1.  ;ACHS*3.1*4   3/28/02  pmf  add issue and service date to display
  1.  ;ACHS*3.1*6 3.28.03 IHS/SET/FCJ FIX SPACE DISPLAY
  1.  ;S DIC("W")="W ""ISS: "",$E($P(^(0),U,2),4,5),""/"",$E($P(^(0),U,2),6,7),""/"",($E($P(^(0),U,2),1,3)+1700),""    SERV: "",$E($P(^(0),U,4),4,5),""/"",$E($P(^(0),U,4),6,7),""/"",($E($P(^(0),U,4),1,3)+1700)"  ;  ACHS*3.1*6
  1.  S DIC("W")="W "" ISS: "",$E($P(^(0),U,2),4,5),""/"",$E($P(^(0),U,2),6,7),""/"",($E($P(^(0),U,2),1,3)+1700),""  SRV: "",$E($P(^(0),U,4),4,5),""/"",$E($P(^(0),U,4),6,7),""/"",($E($P(^(0),U,4),1,3)+1700)"  ;  ACHS*3.1*6
  1.  ;
  1.  ;
  1.  D ^DIC
  1.  Q:+Y<0
  1.  S ACHSA=+Y
  1.  Q
  1.  ;
  1. PP ;
  1.  S Y(0)=$G(Y(0))
  1.  G P0:$P(Y(0),U,6)'="Y"!($P(Y(0),U,7)']"")
  1.  G P0:'$D(^DPT($P(Y(0),U,7),0))
  1.  S DFN=$P(Y(0),U,7)
  1.  G P1
  1.  ;
  1. P0 ;
  1.  G NAMERR:'$D(^ACHSDEN(DUZ(2),"D",ACHSA,10))
  1.  G NAMERR:$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,10)),U)']""
  1. P1 ;
  1.  W !!,"You have chosen "_ACHDOCT_" document ",$P(Y(0),U),!!
  1.  G P2:'$D(DFN)
  1.  W $P($G(^DPT(DFN,0)),U),!
  1.  S A=$G(^DPT(DFN,.11))
  1.  W $P(A,U),!,$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 P3
  1.  ;
  1. P2 ;
  1.  S A=$G(^ACHSDEN(DUZ(2),"D",ACHSA,10))
  1.  W $P(A,U),!,$P(A,U,2),!,$P(A,U,3)
  1.  S ACHDST=$P(A,U,4)
  1.  I ACHDST]"",$D(^DIC(5,ACHDST,0)) W " ",$P($G(^DIC(5,ACHDST,0)),U,2)
  1.  W " ",$P(A,U,5),!!
  1. P3 ;
  1.  W "Date of service ",$$FMTE^XLFDT($$DN^ACHS(0,4)),!!
  1.  S %=$$DIR^ACHS("Y","Is this correct","YES","Did you select the correct document?","",2)
  1.  I $D(DTOUT)!$D(DUOUT) S ACHDLKER="",DONE=1
  1.  I % S DONE=1
  1.  Q
  1.  ;
  1. NAMERR ;
  1.  W !!,*7,"No valid PATIENT NAME in this file.",!,"No letter may be printed until a valid patient is entered.",!!
  1.  Q
  1.  ;