- 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
