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

BMCPCCL.m

Go to the documentation of this file. 
  1. BMCPCCL ; IHS/PHXAO/TMJ - PCC LINK FR RCIS OUTSIDE VISIT ;
  1.  ;;4.0;REFERRED CARE INFO SYSTEM;**3,10**;JAN 09, 2006;Build 101
  1.  ;4.0*3 10.30.2007 IHS/OIT/FCJ ADDED CSV CHANGES
  1.  ;THIS IS FOR THE REFERRED VISIT AND NON-CHS TYPE 
  1.  ;
  1.  ;BMCRIEN=RCIS RECORD NUMBER
  1.  ;
  1.  ;
  1. START ;EP - ENTRY POINT BY TASKMAN
  1.  S BMCVFL=0  ;*9
  1.  Q:'BMCPCC  ;no pcc link active
  1.  Q:'$D(^BMCREF(BMCRIEN))
  1.  D PROC
  1.  D XIT
  1.  Q
  1. PROC ;
  1.  S BMCR0=^BMCREF(BMCRIEN,0),BMCR11=$G(^BMCREF(BMCRIEN,11)),BMCERR=0
  1.  I $P(BMCR11,U,6)="" W $C(7),$C(7),!!,"Attempting PCC Link - NO ACTUAL BEGIN DATE OF SERVICE ENTERED.  LINK FAILED.",!! D CONT S BMCERR=1 Q
  1.  Q:BMCRTYPE="C"  ;don't pass chs visits
  1.  Q:BMCRSTAT'="C1"  ;quit if not closed - action occurred
  1.  ;Delete a PCC Visit Then Create A PCC Visit
  1.  ;I $P(BMCR0,U,29) D DELETE  ;*9
  1.  I $P(BMCR0,U,29) S BMCVFL=1 D DELETE  ;*9
  1.  W !,"Creating New PCC Visit, Hold on....."
  1.  D ADD
  1.  Q
  1. ADD ;add a visit
  1.  D SETVISIT Q:BMCERR
  1.  D ^APCDALV
  1.  I $D(APCDALVR("APCDAFLG")) W $C(7),$C(7),!!,"Attempting PCC Link - PCC VISIT CREATION FAILED.  LINK FAILED.",!! S BMCERR=1 D CONT Q
  1.  S BMCVSIT=APCDALVR("APCDVSIT")
  1.  D VFILES
  1.  K DR,DA,DIE S DA=BMCRIEN,DIE="^BMCREF(",DR=".29////"_BMCVSIT D ^DIE
  1.  ;NO ERROR CHECK ABOVE !!
  1.  Q
  1. SETVISIT ;set up visit values
  1.  D KILL
  1.  S APCDALVR("AUPNTALK")=""
  1.  S APCDALVR("APCDDATE")=$P(BMCR11,U,6)
  1.  S APCDALVR("APCDTYPE")=BMCRTYPE I APCDALVR("APCDTYPE")="" W $C(7),$C(7),!!,"Attempting PCC Link - TYPE OF REFERRAL ENTERED.  LINK FAILED.",!! D CONT S BMCERR=1 Q
  1.  S APCDALVR("APCDPAT")=BMCDFN
  1.  S APCDALVR("APCDLOC")=$$VALI^XBDIQ1(90001.31,DUZ(2),.11) I APCDALVR("APCDLOC")="" W $C(7),$C(7),!!,"Attempting PCC Link - OTHER LOCATION ENTERED IN STIE FILE.  LINK FAILED.",!! D CONT S BMCERR=1 Q
  1.  S APCDALVR("APCDCAT")="E"
  1.  S APCDALVR("APCDAUTO")="",APCDALVR("APCDANE")=""
  1.  S APCDALVR("APCDOLOC")=$$FACREF^BMCRLU(BMCRIEN)
  1.  Q
  1. DELETE ;delete visit in PCC
  1.  W !,"Deleting associated PCC Visit.",!
  1.  S APCDVDLT=$P(BMCR0,U,29) I APCDVDLT="" Q
  1.  D ^APCDVDLT
  1.  Q
  1. KILL ;
  1.  K APCDALVR,APCDPAT,APCDLOC,APCDTYPE,APCDCAT,APCDCLN,APCDTPRO,APCDTPS,APCDTPOV,APCDTNQ,APCDTTOP,APCDTLOU,APCDTPRV,APCDTAT,APCDATMP,APCDAFLG,APCDAUTO,APCDANE,AUPNTALK,APCDAPPT,APCDOLOC,APCDVDLT
  1.  Q
  1. CONT ;
  1.  S DIR(0)="E",DIR("A")="Hit <RETURN> to continue" K DA D ^DIR K DIR
  1.  Q
  1. XIT ;CLEAN UP AND EXIT
  1.  D KILL
  1.  LOCK -^BMCREF(BMCRIEN,0)
  1.  K BMCVFL,BMCR0,BMCERR,BMCR11,BMCVSIT,BMCX,BMCC
  1.  D KILL^AUPNPAT
  1.  K X,A,D,D0,DO,DA,DIE,DR,DIY,DIU,DIW,DIV,DIC,DI,DDH,DQ,DIPGM
  1.  Q
  1. VFILES ;create v file entries
  1.  D POV
  1.  D PRC
  1.  D VHOSP:$P(BMCR0,U,14)="I"
  1.  Q
  1. POV ;PURPOSE OF VISIT
  1.  D KILL
  1.  S APCDALVR("APCDVSIT")=BMCVSIT
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
  1.  S APCDALVR("APCDPAT")=BMCDFN
  1.  S APCDALVR("APCDOVRR")=""
  1.  I '$D(^BMCDX("AD",BMCRIEN)) D NODX Q
  1.  S (BMCX,BMCC)=0 F  S BMCX=$O(^BMCDX("AD",BMCRIEN,BMCX)) Q:BMCX'=+BMCX  I $P(^BMCDX(BMCX,0),U,4)="F" D POV1
  1.  Q:BMCC
  1.  S BMCX=0 F  S BMCX=$O(^BMCDX("AD",BMCRIEN,BMCX)) Q:BMCX'=+BMCX  I $P(^BMCDX(BMCX,0),U,4)="P" D POV1
  1.  Q
  1. POV1 ;
  1.  S BMCC=BMCC+1
  1.  S APCDALVR("APCDTPOV")="`"_$P(^BMCDX(BMCX,0),U)
  1.  S APCDALVR("APCDTPS")=$P(^BMCDX(BMCX,0),U,5)
  1.  S APCDALVR("APCDTNQ")=$S($P(^BMCDX(BMCX,0),U,6):"`"_$P(^(0),U,6),1:"REFERRED FOR: "_$E($$VAL^XBDIQ1(90001.01,BMCX,.019),1,65))
  1.  D ^APCDALVR
  1.  ;4.0*3 10.30.2007 IHS/OIT/FCJ ADDED CSV CHANGES
  1.  ;I $D(APCDALVR("APCDAFLG")) W $C(7),$C(7),!!,"Attempting PCC Link - POV ",$P(^ICD9(+^BMCDX(BMCX,0),0),U)_" FAILED.",!! S BMCERR=1 D CONT
  1.  I $D(APCDALVR("APCDAFLG")) W $C(7),$C(7),!!,"Attempting PCC Link - POV ",$P($$ICDDX^ICDCODE(+^BMCDX(BMCX,0),0),U,2)_" FAILED.",!! S BMCERR=1 D CONT
  1.  Q
  1. PRC ;
  1.  D KILL
  1.  S APCDALVR("APCDVSIT")=BMCVSIT
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010.08 (ADD)]"
  1.  S APCDALVR("APCDPAT")=BMCDFN
  1.  S APCDALVR("APCDOVRR")=""
  1.  S (BMCX,BMCC)=0 F  S BMCX=$O(^BMCPX("AD",BMCRIEN,BMCX)) Q:BMCX'=+BMCX  I $P(^BMCPX(BMCX,0),U,4)="F" D PRC1
  1.  Q:BMCC
  1.  S BMCX=0 F  S BMCX=$O(^BMCPX("AD",BMCRIEN,BMCX)) Q:BMCX'=+BMCX  I $P(^BMCPX(BMCX,0),U,4)="P" D PRC1
  1.  Q:'$D(^BMCDX("AD",BMCRIEN))
  1.  I $P(BMCR0,U,13) D
  1.  .S APCDALVR("APCDVSIT")=BMCVSIT
  1.  .S APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
  1.  .S APCDALVR("APCDPAT")=BMCDFN
  1.  .;S APCDALVR("APCDTPOV")="V68.81" ;BMC*4.0*10
  1.  .S BMCDOS=$$AVDOS^BMCRLU(BMCRIEN,"N") S APCDALVR("APCDTPOV")=$S(BMCDOS>(BMCDX10-1):"Z04.9",1:"V68.81") ;BMC*4.0*10
  1.  .S APCDALVR("APCDTNQ")="REFERRED FOR: "_$P(^BMCTSVC($P(BMCR0,U,13),0),U)
  1.  .D ^APCDALVR
  1.  .I $D(APCDALVR("APCDAFLG")) W $C(7),$C(7),!!,"Attempting PCC Link - POV CPT CATEGORY FAILED.",!! S BMCERR=1 D CONT
  1.  .Q
  1.  Q
  1. PRC1 ;
  1.  S %=$O(^ICPT($P(^BMCPX(BMCX,0),U),"ICD","B",0))
  1.  I %="" S %=$O(^ICD0("AB",99.99,0))
  1.  S APCDALVR("APCDTPRC")="`"_%
  1.  S APCDALVR("APCDTNQ")=$S($P(^BMCPX(BMCX,0),U,6):"`"_$P(^(0),U,6),1:"REFERRED FOR: "_$E($$VAL^XBDIQ1(90001.02,BMCX,.019),1,65))
  1.  D ^APCDALVR
  1.  ;4.0*3 10.30.2007 IHS/OIT/FCJ ADDED CSV CHANGES
  1.  ;I $D(APCDALVR("APCDAFLG")) W $C(7),$C(7),!!,"Attempting PCC Link - POV ",$P(^ICPT(+^BMCPX(BMCX,0),0),U)_" FAILED.",!! S BMCERR=1 D CONT
  1.  I $D(APCDALVR("APCDAFLG")) W $C(7),$C(7),!!,"Attempting PCC Link - POV ",$P($$CPT^ICPTCOD(+^BMCPX(BMCX,0),0),U,2)_" FAILED.",!! S BMCERR=1 D CONT
  1.  Q
  1. VHOSP ;
  1.  D KILL
  1.  S APCDALVR("APCDVSIT")=BMCVSIT
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010.02 (ADD)]"
  1.  S APCDALVR("APCDPAT")=BMCDFN
  1.  S APCDALVR("APCDLOOK")=$P(BMCR11,U,6)
  1.  D ^APCDALVR
  1.  I $D(APCDALVR("APCDAFLG")) W $C(7),$C(7),!,"Attempting PCC Link - V HOSPITALIZATION FAILED",! S BMCERR=1 D CONT
  1.  Q
  1. NODX ;no dx's entered, use 2 categories as Pov's
  1.  I $P(BMCR0,U,12) D
  1.  .S APCDALVR("APCDVSIT")=BMCVSIT
  1.  .S APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
  1.  .S APCDALVR("APCDPAT")=BMCDFN
  1.  .;S APCDALVR("APCDTPOV")="V68.81";BMC*4.0*10
  1.  .S BMCDOS=$$AVDOS^BMCRLU(BMCRIEN,"N") S APCDALVR("APCDTPOV")=$S(BMCDOS>(BMCDX10-1):"Z04.9",1:"V68.81")  ;BMC*4.0*10
  1.  .S APCDALVR("APCDTNQ")="REFERRED FOR: "_$P(^BMCTDXC($P(BMCR0,U,12),0),U)
  1.  .D ^APCDALVR
  1.  .I $D(APCDALVR("APCDAFLG")) W $C(7),$C(7),!!,"Attempting PCC Link - POV DIAGNOSTIC CATEGORY FAILED.",!! S BMCERR=1 D CONT
  1.  .Q
  1.   I $P(BMCR0,U,13) D
  1.  .S APCDALVR("APCDVSIT")=BMCVSIT
  1.  .S APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
  1.  .S APCDALVR("APCDPAT")=BMCDFN
  1.  .;S APCDALVR("APCDTPOV")="V68.81" ;BMC*4.0*10
  1.  .S BMCDOS=$$AVDOS^BMCRLU(BMCRIEN,"N") S APCDALVR("APCDTPOV")=$S(BMCDOS>(BMCDX10-1):"Z04.9",1:"V68.81") ;BMC*4.0*10
  1.  .S APCDALVR("APCDTNQ")="REFERRED FOR: "_$P(^BMCTSVC($P(BMCR0,U,13),0),U)
  1.  .D ^APCDALVR
  1.  .I $D(APCDALVR("APCDAFLG")) W $C(7),$C(7),!!,"Attempting PCC Link - POV CPT CATEGORY FAILED.",!! S BMCERR=1 D CONT
  1.  .Q
  1.  Q