BMCFUNC1 ; IHS/PHXAO/TMJ - FIX UNCODED CPT CODES ;
;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
PRO ;EP
S BMCFILE=90001.02,BMCTEMP="[BMC FUP PROC]" D GETCODE G PROCESS
I $P($G(^APCCCTRL(DUZ(2),0)),U,6)="" S BMC999=$O(^ICPT("B",00099,"")) G PROCESS
;
GETCODE ;
I $P($G(^APCCCTRL(DUZ(2),0)),U,5)="" D SETDEF Q
S BMC999=$P(^APCCCTRL(DUZ(2),0),U,5)
Q
SETDEF ;SET DEFAULT OF 00099
S BMC999=$O(^ICPT("B","00099",""))
Q
XIT ;
K BMCFILE,BMCDFN,BMCVDG,BMCVIGR,BMCCONT,BMCTEMP,BMC999,BMCG,BMCL,BMCHRN,BMCDOB,BMCVSIT,AUPNSEX,AUPNPAT,AUPNDOB,AUPNDAYS,BMCEIN,AUPNDOD,BMCCAT
Q
PROCESS ;
I BMC999="" W !!,"ERROR -- 00099 NOT IN CPT FILE, NOTIFY YOUR SUPERVISOR" G XIT
S BMCEIN="",BMCDFN="",U="^"
I '$D(^DIC(BMCFILE)) W !!,"FILE DOES NOT EXIST -- NOTIFY YOUR SUPERVISOR" G XIT
S BMCVDG=$P(^DIC(BMCFILE,0),U) I BMCVDG="" W !,"ERROR IN ^DIC -- NOTIFY PROGRAMMER" G XIT
S BMCVDG=^DIC(BMCFILE,0,"GL")
S BMCG=BMCVDG_"""B"",BMC999)"
I '$D(@BMCG) W ?10,!!,"***There are no 00099 codes to change.***" H 3 Q
S BMCVIGR=BMCVDG_"""B"",BMC999,BMCDFN)"
W !!,"Searching the ",$P(^DIC(BMCFILE,0),U)," File",!
S BMCDFN=0,BMCCONT=1 F BMCL=0:0 S BMCDFN=$O(@BMCVIGR) Q:BMCDFN'=+BMCDFN D CONT Q:'BMCCONT D BMCDIE
W !!,"All done with the ",$P(^DIC(BMCFILE,0),U)," file",!
D XIT
Q
CONT ;
W !!
S DIR("A")="Continue",DIR("B")="Y",DIR(0)="Y" D ^DIR
I $D(DIRUT) S X="N"
S:"Nn"[X BMCCONT=""
W !
K DIR,DIRUT,DUOUT,DTOUT,DIROUT
Q
BMCDIE ;
S BMCG=BMCVDG_"BMCDFN,0)" S Y=$P(@BMCG,U,2),BMCVSIT=$P(@BMCG,U,3) I Y=""!(BMCVSIT="") W !,"ERROR IN GLOBAL -- NOTIFY PROGRAMMER - PATIENT OR VISIT DFN MISSING" Q
D ^AUPNPAT
I $L(BMCFILE)>7,AUPNDOB]"" S X2=AUPNDOB,X1=$P(^BMCREF(BMCVSIT,0),U)\1 D ^%DTC S AUPNDAYS=X ; re-set days of age to visit date-dob
S Y=AUPNDOB X ^DD("DD") S BMCDOB=Y
S BMCHRN="" I $D(^AUPNPAT(AUPNPAT,41,DUZ(2),0)) S BMCHRN=$P(^AUPNPAT(AUPNPAT,41,DUZ(2),0),U,2)
W !,"NAME: ",$P(^DPT(AUPNPAT,0),U)," DOB: ",BMCDOB," SEX: ",AUPNSEX," HRN: ",$S(BMCHRN]"":BMCHRN,1:"NONE")
;I $L(BMCFILE)>7 S BMCCAT=$P(^BMCREF(BMCVSIT,0),U,7) W !,"DATE OF VISIT: " S Y=$P(^AUPNVSIT(BMCVSIT,0),U) D DT^DIO2 S Y=""
;
;
;NOTE TO TONI----DECIDE WHAT REFERRAL INFOR TO DISPLAY
;W !!,"HELLO",!!
;S BMCRNUM=$$VALI^XBDIQ1(90001,BMCVDG,.02) I $D(BMCRNUM) W !,"REFERRAL NUMBER: ",BMCRNUM
;
;
S DA=BMCDFN,DIE=BMCVDG,DR=BMCTEMP D ^DIE K DA,DIE,DR
;
;I $L(BMCFILE)>7 S AUPNVSIT=BMCVSIT D MOD^AUPNVSIT
;Stuff Todays's Date in field .27 Date Last Modified in BMCREF(
;
S DA=BMCVSIT,DIE="^BMCREF(",DR=".27////"_DT D ^DIE K DA,DIE,DIU,DIV,DR
;
Q
BMCFUNC1 ; IHS/PHXAO/TMJ - FIX UNCODED CPT CODES ;
+1 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
PRO ;EP
+1 SET BMCFILE=90001.02
SET BMCTEMP="[BMC FUP PROC]"
DO GETCODE
GOTO PROCESS
+2 IF $PIECE($GET(^APCCCTRL(DUZ(2),0)),U,6)=""
SET BMC999=$ORDER(^ICPT("B",00099,""))
GOTO PROCESS
+3 ;
GETCODE ;
+1 IF $PIECE($GET(^APCCCTRL(DUZ(2),0)),U,5)=""
DO SETDEF
QUIT
+2 SET BMC999=$PIECE(^APCCCTRL(DUZ(2),0),U,5)
+3 QUIT
SETDEF ;SET DEFAULT OF 00099
+1 SET BMC999=$ORDER(^ICPT("B","00099",""))
+2 QUIT
XIT ;
+1 KILL BMCFILE,BMCDFN,BMCVDG,BMCVIGR,BMCCONT,BMCTEMP,BMC999,BMCG,BMCL,BMCHRN,BMCDOB,BMCVSIT,AUPNSEX,AUPNPAT,AUPNDOB,AUPNDAYS,BMCEIN,AUPNDOD,BMCCAT
+2 QUIT
PROCESS ;
+1 IF BMC999=""
WRITE !!,"ERROR -- 00099 NOT IN CPT FILE, NOTIFY YOUR SUPERVISOR"
GOTO XIT
+2 SET BMCEIN=""
SET BMCDFN=""
SET U="^"
+3 IF '$DATA(^DIC(BMCFILE))
WRITE !!,"FILE DOES NOT EXIST -- NOTIFY YOUR SUPERVISOR"
GOTO XIT
+4 SET BMCVDG=$PIECE(^DIC(BMCFILE,0),U)
IF BMCVDG=""
WRITE !,"ERROR IN ^DIC -- NOTIFY PROGRAMMER"
GOTO XIT
+5 SET BMCVDG=^DIC(BMCFILE,0,"GL")
+6 SET BMCG=BMCVDG_"""B"",BMC999)"
+7 IF '$DATA(@BMCG)
WRITE ?10,!!,"***There are no 00099 codes to change.***"
HANG 3
QUIT
+8 SET BMCVIGR=BMCVDG_"""B"",BMC999,BMCDFN)"
+9 WRITE !!,"Searching the ",$PIECE(^DIC(BMCFILE,0),U)," File",!
+10 SET BMCDFN=0
SET BMCCONT=1
FOR BMCL=0:0
SET BMCDFN=$ORDER(@BMCVIGR)
IF BMCDFN'=+BMCDFN
QUIT
DO CONT
IF 'BMCCONT
QUIT
DO BMCDIE
+11 WRITE !!,"All done with the ",$PIECE(^DIC(BMCFILE,0),U)," file",!
+12 DO XIT
+13 QUIT
CONT ;
+1 WRITE !!
+2 SET DIR("A")="Continue"
SET DIR("B")="Y"
SET DIR(0)="Y"
DO ^DIR
+3 IF $DATA(DIRUT)
SET X="N"
+4 IF "Nn"[X
SET BMCCONT=""
+5 WRITE !
+6 KILL DIR,DIRUT,DUOUT,DTOUT,DIROUT
+7 QUIT
BMCDIE ;
+1 SET BMCG=BMCVDG_"BMCDFN,0)"
SET Y=$PIECE(@BMCG,U,2)
SET BMCVSIT=$PIECE(@BMCG,U,3)
IF Y=""!(BMCVSIT="")
WRITE !,"ERROR IN GLOBAL -- NOTIFY PROGRAMMER - PATIENT OR VISIT DFN MISSING"
QUIT
+2 DO ^AUPNPAT
+3 ; re-set days of age to visit date-dob
IF $LENGTH(BMCFILE)>7
IF AUPNDOB]""
SET X2=AUPNDOB
SET X1=$PIECE(^BMCREF(BMCVSIT,0),U)\1
DO ^%DTC
SET AUPNDAYS=X
+4 SET Y=AUPNDOB
XECUTE ^DD("DD")
SET BMCDOB=Y
+5 SET BMCHRN=""
IF $DATA(^AUPNPAT(AUPNPAT,41,DUZ(2),0))
SET BMCHRN=$PIECE(^AUPNPAT(AUPNPAT,41,DUZ(2),0),U,2)
+6 WRITE !,"NAME: ",$PIECE(^DPT(AUPNPAT,0),U)," DOB: ",BMCDOB," SEX: ",AUPNSEX," HRN: ",$SELECT(BMCHRN]"":BMCHRN,1:"NONE")
+7 ;I $L(BMCFILE)>7 S BMCCAT=$P(^BMCREF(BMCVSIT,0),U,7) W !,"DATE OF VISIT: " S Y=$P(^AUPNVSIT(BMCVSIT,0),U) D DT^DIO2 S Y=""
+8 ;
+9 ;
+10 ;NOTE TO TONI----DECIDE WHAT REFERRAL INFOR TO DISPLAY
+11 ;W !!,"HELLO",!!
+12 ;S BMCRNUM=$$VALI^XBDIQ1(90001,BMCVDG,.02) I $D(BMCRNUM) W !,"REFERRAL NUMBER: ",BMCRNUM
+13 ;
+14 ;
+15 SET DA=BMCDFN
SET DIE=BMCVDG
SET DR=BMCTEMP
DO ^DIE
KILL DA,DIE,DR
+16 ;
+17 ;I $L(BMCFILE)>7 S AUPNVSIT=BMCVSIT D MOD^AUPNVSIT
+18 ;Stuff Todays's Date in field .27 Date Last Modified in BMCREF(
+19 ;
+20 SET DA=BMCVSIT
SET DIE="^BMCREF("
SET DR=".27////"_DT
DO ^DIE
KILL DA,DIE,DIU,DIV,DR
+21 ;
+22 QUIT
