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