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

APCD3ME.m

Go to the documentation of this file. 
  1. APCD3ME ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED ;
  1.  ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
  1.  ;
  1.  ;
  1.  ;
  1. EN ;EP - called from input templates
  1.  D EN^XBNEW("EN1^APCD3ME","APCDVSIT;APCDDATE;APCDCAT;APCDPAT;APCDBEEP;AUPN*")
  1.  Q
  1.  ;
  1. EN1 ;EP - called from XBNEW
  1.  D PROCESS
  1.  D XIT
  1.  Q
  1.  ;
  1. XIT ;-- exit the routine
  1.  K APCDX
  1.  K X,Y
  1.  D ^XBFMK
  1.  Q
  1.  ;
  1. PROCESS ;-- lets process 
  1.  S APCDOVRR=1
  1.  K APCD3MER
  1.  I '$G(APCDVSIT) W !!,"Valid visit missing!",! Q
  1.  S DIR(0)="Y",DIR("A")="Are you ready to send the visit information to 3M for coding",DIR("B")="Y" KILL DA D ^DIR KILL DIR
  1.  Q:$D(DIRUT)
  1.  Q:'Y
  1.  I $D(^APCD3MV("B",APCDVSIT)) W !!,$C(7),$C(7),"This visit has already been sent to 3M and coded.  I will",!,"file the POV's and Procedures now.",! G FILE
  1.  D OUT^APCD3M(APCDVSIT)
  1.  I $D(APCD3MER) W !!,$C(7),$C(7),"Fix error and then come back into this visit and use the 3M mnemonic",!,"  to code the POV's." Q
  1. PASS ;
  1.  W !!,"Visit information has been passed to 3M, switch screens, code the visit and",!,"then press enter below when you are finished coding.",!
  1.  F  S DIR(0)="Y",DIR("A")="Are you done with the coding of the POV's on the 3M coder",DIR("B")="N" KILL DA D ^DIR KILL DIR Q:'$D(DTOUT)  W " Timed out"
  1.  I $D(DIRUT)!('$G(Y)) W !!,"You are exiting without filing the POV's.  You must come back into this",!,"visit and use the 3M mnemonic to code the POV's.",! Q
  1. FILE ;file pov's
  1.  I '$D(^APCD3MV("B",APCDVSIT)) W !!,"The information has not come back from 3M yet.",!! G PASS
  1.  ;file pov's and procedures using fileman templates
  1.  ;
  1.  W !!,"The POV's and Procedures will now be filed into PCC.  You will be prompted to ",!,"complete each entry.",!
  1.  I '$G(BHLIP) D
  1.  . W !,"I can't seem to figure out for 3M Workstation ID !!"
  1.  . S DIR(0)="FO^1:2",DIR("A")="Enter your 3M Workstation ID "
  1.  . KILL DA D ^DIR KILL DIR
  1.  . S BHLIP=$G(X)
  1.  . Q
  1.  S APCDBP=$O(^INTHPC("B","HL IHS 3M SENDER "_BHLIP,0))
  1.  L -^INRHB("RUN",APCDBP)
  1.  F I=1:1:100 K ^INRHB("RUN",APCDBP)
  1.  L -^INRHB("RUN",APCDBP)
  1.  S APCDX=0 F  S APCDX=$O(^APCD3MV(APCDVSIT,11,APCDX)) Q:APCDX'=+APCDX  D FILEPOV
  1.  D ECDCLEAN
  1.  S APCDX=0 F  S APCDX=$O(^APCD3MV(APCDVSIT,12,APCDX)) Q:APCDX'=+APCDX  D FILEPROC
  1.  D CPTCLEAN
  1.  S APCDX=0 F  S APCDX=$O(^APCD3MV(APCDVSIT,13,APCDX)) Q:APCDX'=+APCDX  D FILECPT
  1.  D FILEDRG ;file DRG and HCFA weight if exist
  1.  W !,"All done with 3M coding.",!
  1.  D DELETE ;delete 3m entry from file
  1.  Q
  1.  ;
  1. DELETE ;
  1.  Q:$G(APCD3MER)
  1.  S DA=APCDVSIT,DIK="^APCD3MV(" D ^DIK K DA,DIK
  1.  Q
  1.  ;
  1. FILEDRG ;
  1.  I $P(^AUPNVSIT(APCDVSIT,0),U,7)'="H" Q  ;only hospitalizations
  1.  NEW APCDX,APCDY S APCDX=$P(^APCD3MV(APCDVSIT,0),U,3)
  1.  ;put this in .34 of the visit file
  1.  S DA=APCDVSIT,DR=".34////"_$S(APCDX:"`"_APCDX,1:APCDX),DIE="^AUPNVSIT(" D ^DIE
  1.  I $D(Y) S APCDTERM="Error encountered updating DRG." D ERR
  1.  D ^XBFMK
  1.  K APCDX
  1.  Q
  1.  ;
  1. FILEPOV ;
  1.  NEW APCDICD,APCDICDP
  1.  S APCD3MVM=11
  1.  S X=$P(^APCD3MV(APCDVSIT,11,APCDX,0),U)
  1.  Q:$E(X,1,1)="E"  ;don't file ecodes
  1.  S X=$$CODEN^ICDEX(X,80)
  1.  S X=+X I X=-1 S X=""
  1.  I 'X S APCDTERM="Can't find ICD Code "_$P(^APCD3MV(APCDVSIT,11,APCDX,0),U)_" in the ICD9 Table.  Notify your supervisor." D ERR Q
  1.  ;W !,"Filing POV (Diagnosis) ",$P(^ICD9(X,0),U)," - ",$P(^APCD3MV(APCDVSIT,11,APCDX,0),U,2)
  1.  W !,"Filing POV (Diagnosis) ",$P($$ICDDX^ICDEX(X,$$VD^APCLV(APCDVSIT)),U,2)," - ",$P(^APCD3MV(APCDVSIT,11,APCDX,0),U,2)
  1.  S X="`"_X
  1.  S APCDTPCC=""
  1.  X:$D(^DD(9000010.07,.01,12.1)) ^DD(9000010.07,.01,12.1) S DIC="^ICD9(",DIC(0)="Q" D ^DIC K DIC
  1.  I Y=-1 S APCDTERM="ICD Lookup failed.  Notify your supervisor." D ERR Q
  1.  S APCDLOOK="`"_+Y  ;,APCDTNAR=$P(^APCD3MV(APCDVSIT,11,APCDX,0),U,2)
  1.  ;S APCDICOD=$P($G(^APCD3MV(APCDVSIT,11,APCDX,0)),U,4) ;injury code
  1.  S DIE="^AUPNVSIT(",DR="[APCD 3MPV (ADD)]",DA=APCDVSIT,DIE("NO^")=1 D ^DIE,^XBFMK
  1.  ;delete entry in multiple
  1.  S DA=APCDX,DA(1)=APCDVSIT,DIK="^APCD3MV("_DA(1)_",11," D ^DIK K DA,DIK
  1.  W !
  1.  D ^XBFMK
  1.  Q
  1.  ;
  1. FILEPROC ;
  1.  NEW APCDICD,APCDICDP
  1.  S APCD3MVM=12
  1.  S X=$P(^APCD3MV(APCDVSIT,12,APCDX,0),U),X=+$$CODEN^ICDEX(X,80.1) I $P(X,U)=-1 S X=""
  1.  I 'X S APCDTERM="Can't find ICD Code "_$P(^APCD3MV(APCDVSIT,12,APCDX,0),U)_" in the ICD0 Table.  Notify your supervisor." D ERR Q
  1.  W !,"Filing Procedure ",$P($$ICDOP^ICDEX(X,$$VD^APCLV(APCDVSIT),,"I"),U,2)," - ",$P(^APCD3MV(APCDVSIT,12,APCDX,0),U,2)
  1.  S X="`"_X
  1.  S APCDTPCC=""
  1.  X:$D(^DD(9000010.08,.01,12.1)) ^DD(9000010.08,.01,12.1) S DIC="^ICD0(",DIC(0)="Q" D ^DIC K DIC
  1.  I Y=-1 S APCDTERM="ICD0 Lookup failed.  Notify your supervisor." D ERR Q
  1.  S APCDLOOK="`"_+Y  ;,APCDTNAR=$P(^APCD3MV(APCDVSIT,12,APCDX,0),U,2)
  1.  S DIE="^AUPNVSIT(",DR="[APCD 3MOP (ADD)]",DA=APCDVSIT,DIE("NO^")=1 D ^DIE
  1.  S DA(1)=APCDVSIT,DA=APCDX,DIE="^APCD3MV("_APCDVSIT_",12,",DR=".01///@" D ^DIE,^XBFMK
  1.  W !
  1.  D ^XBFMK
  1.  Q
  1.  ;
  1. FILECPT ;-- lets file from the APCD 3MCPE MNEMONIC
  1.  NEW APCDCPT,APCDCPTP
  1.  S APCD3MVM=13
  1.  S X=$P(^APCD3MV(APCDVSIT,13,APCDX,0),U)
  1.  S X=$TR($P(X,"-")," ")
  1.  ;S X=$O(^ICPT("B",X,0))
  1.  S X=$P($$CPT^ICPTCOD(X,$$VD^APCLV(APCDVSIT)),U,1) I X=-1 S X=""
  1.  I 'X S APCDTERM="Can't find CPT Code "_$P(^APCD3MV(APCDVSIT,13,APCDX,0),U)_" in the CPT Table.  Notify your supervisor." D ERR Q
  1.  S APCDCMOD=$P(^APCD3MV(APCDVSIT,13,APCDX,0),U,2)
  1.  ;W !,"Filing CPT ",$P(^ICPT(X,0),U)," - "_$P($G(^ICPT(X,0)),U,2)_"  Modifier: ",$P(^APCD3MV(APCDVSIT,13,APCDX,0),U,2)
  1.  W !,"Filing CPT ",$P($$CPT^ICPTCOD(X,$$VD^APCLV(APCDVSIT)),U,2)," - "_$P($$CPT^ICPTCOD(X,$$VD^APCLV(APCDVSIT)),U,3)_"  Modifier: ",$P(^APCD3MV(APCDVSIT,13,APCDX,0),U,2)
  1.  S X="`"_X
  1.  S APCDTPCC=""
  1.  X:$D(^DD(9000010.18,.01,12.1)) ^DD(9000010.18,.01,12.1) S DIC="^ICPT(",DIC(0)="Q" D ^DIC K DIC
  1.  I Y=-1 S APCDTERM="ICPT Lookup failed.  Notify your supervisor." D ERR Q
  1.  S APCDLOOK="`"_+Y
  1.  S DIE="^AUPNVSIT(",DR="[APCD 3MCPE (ADD)]",DA=APCDVSIT,DIE("NO^")=1 D ^DIE
  1.  S DA(1)=APCDVSIT,DA=APCDX,DIE="^APCD3MV("_APCDVSIT_",13,",DR=".01///@" D ^DIE,^XBFMK
  1.  W !
  1.  D ^XBFMK
  1.  Q
  1.  ;
  1. ECDCLEAN ;-- cleanup ecodes from the dx multiple
  1.  S APCDECDA=0 F  S APCDECDA=$O(^APCD3MV(APCDVSIT,11,APCDECDA)) Q:'APCDECDA  D
  1.  . Q:$E($G(^APCD3MV(APCDVSIT,11,APCDECDA,0)),1,1)'="E"
  1.  . S DA(1)=APCDVSIT,DA=APCDECDA,DIE="^APCD3MV("_APCDVSIT_",11,",DR=".01///@" D ^DIE,^XBFMK
  1.  Q
  1.  ;
  1. CPTCLEAN ;-- cleanup cpt multiple before calling the 3mcpe mneumonic
  1.  S APCDCPDA=0 F  S APCDCPDA=$O(APCDCPTU(APCDCPDA)) Q:'APCDCPDA  D
  1.  . S APCDVSIT=$G(APCDCPTU(APCDCPDA))
  1.  . S DA(1)=APCDVSIT,DA=APCDCPDA,DIE="^APCD3MV("_APCDVSIT_",13,",DR=".01///@" D ^DIE,^XBFMK
  1.  Q
  1.  ;
  1. ERR ;
  1.  S APCD3MER=1 W !!,APCDTERM
  1.  S DA(1)=APCDVSIT,DA=APCDX,DIE="^APCD3MV("_APCDVSIT_",APCD3MVM,",DR=".03///"_$E(APCDTERM,1,50) D ^DIE
  1.  D ^XBFMK
  1.  Q