- BMCREF ; IHS/PHXAO/TMJ - SET REFERRAL VARIABLES ;
- ;;4.0;REFERRED CARE INFO SYSTEM;**7**;JAN 09, 2006;Build 101
- ;
- ; BMCRIEN=referral ien
- ; BMCRDATE=referral date in internal FileMan form (.01 field)
- ; BMCRNUMB=referral number (.02 field)
- ; BMCDFN=patient ien (.03 field)
- ; BMCRTYPE=type of referral (.04 field)
- ; BMCCHSCT=CHS authorization count (1115 field)
- ; BMCRIO=Inpatient or Outpatient (.14 field)
- ; BMCREC("PAT NAME")=patient name
- ; BMCREC("REF DATE")=referral date in external form
- ; BMCSUF=Secondary referral suffix ;4.0*7
- ;
- START ;
- Q:$D(BMCOVRPS) ;override post selection variable
- S (BMCCHSCT,BMCRIEN,BMCRDATE,BMCRNUMB,BMCDFN,BMCRTYPE,BMCRIO,BMCREC("PAT NAME"),BMCREC("REF DATE"))=""
- Q:'$G(Y)
- Q:'$D(^BMCREF(+Y,0))
- NEW X
- S BMCRIEN=+Y
- S X=^BMCREF(BMCRIEN,0)
- S BMCRDATE=$P(X,U)
- S BMCRNUMB=$P(X,U,2)
- S BMCDFN=$P(X,U,3)
- S BMCRSTAT=$P(X,U,15)
- S BMCRTYPE=$P(X,U,4)
- S BMCRIO=$P(X,U,14)
- S:$G(BMCDFN) BMCREC("PAT NAME")=$P(^DPT(BMCDFN,0),U)
- ;
- S BMCCHSCT=+$P($G(^BMCREF(BMCRIEN,11)),U,15)
- S BMCSUF=$P($G(^BMCREF(BMCRIEN,1)),U) ;4.0 FCJ
- ;
- NEW Y
- S Y=BMCRDATE
- D DD^%DT
- S BMCREC("REF DATE")=Y
- Q
- ;
- ;
- ;
- SETCA ;EP - trigger the CHS APPROVAL STATUS AUDIT multiple from
- ;call fileman with a xbnew call
- NEW BMCCA
- S BMCCA("DA")=DA,BMCCA("NEW")=$S($G(BMCNEWV)]"":BMCNEWV,1:X),BMCCA("OLD")=$S($G(BMCOLDV)]"":BMCOLDV,$D(D):$P(D,U,12),1:""),BMCCA("OPT")=$P($G(XQY0),U)
- I BMCCA("NEW")=BMCCA("OLD") K BMCCA Q ;don't update audit if values are the same
- D EN^XBNEW("SETCA1^BMCREF","BMCCA")
- K BMCCA
- Q
- SETCA1 ;EP entry point for XBNEW
- S DA=BMCCA("DA")
- S DIADD=1,DIE="^BMCREF(",DR="4200///NOW",DR(2,90001.42)=".02////^S X=DUZ;.04///"_$G(BMCCA("OLD"))_";.05///"_$G(BMCCA("NEW"))_";.03///"_$S(BMCCA("OPT")]"":BMCCA("OPT"),1:"UNKNOWN") D ^DIE K DIE,DA,DR,DIADD
- Q
- KILLCA ;EP trigger the CHS APPROVAL STATUS AUDIT multiple
- ;from the kill side of CHS APPROVAL STATUS xref AAS
- ;if this is not a delete just quit and set on set side
- Q:$P($G(^BMCREF(DA,11)),U,12)]"" ;this is a change or add
- NEW BMCCA
- S BMCCA("DA")=DA,BMCCA("OLD")=X,BMCCA("NEW")=""
- D EN^XBNEW("SETCA1^BMCREF","BMCCA")
- K BMCCA
- Q
- BMCREF ; IHS/PHXAO/TMJ - SET REFERRAL VARIABLES ;
- +1 ;;4.0;REFERRED CARE INFO SYSTEM;**7**;JAN 09, 2006;Build 101
- +2 ;
- +3 ; BMCRIEN=referral ien
- +4 ; BMCRDATE=referral date in internal FileMan form (.01 field)
- +5 ; BMCRNUMB=referral number (.02 field)
- +6 ; BMCDFN=patient ien (.03 field)
- +7 ; BMCRTYPE=type of referral (.04 field)
- +8 ; BMCCHSCT=CHS authorization count (1115 field)
- +9 ; BMCRIO=Inpatient or Outpatient (.14 field)
- +10 ; BMCREC("PAT NAME")=patient name
- +11 ; BMCREC("REF DATE")=referral date in external form
- +12 ; BMCSUF=Secondary referral suffix ;4.0*7
- +13 ;
- START ;
- +1 ;override post selection variable
- IF $DATA(BMCOVRPS)
- QUIT
- +2 SET (BMCCHSCT,BMCRIEN,BMCRDATE,BMCRNUMB,BMCDFN,BMCRTYPE,BMCRIO,BMCREC("PAT NAME"),BMCREC("REF DATE"))=""
- +3 IF '$GET(Y)
- QUIT
- +4 IF '$DATA(^BMCREF(+Y,0))
- QUIT
- +5 NEW X
- +6 SET BMCRIEN=+Y
- +7 SET X=^BMCREF(BMCRIEN,0)
- +8 SET BMCRDATE=$PIECE(X,U)
- +9 SET BMCRNUMB=$PIECE(X,U,2)
- +10 SET BMCDFN=$PIECE(X,U,3)
- +11 SET BMCRSTAT=$PIECE(X,U,15)
- +12 SET BMCRTYPE=$PIECE(X,U,4)
- +13 SET BMCRIO=$PIECE(X,U,14)
- +14 IF $GET(BMCDFN)
- SET BMCREC("PAT NAME")=$PIECE(^DPT(BMCDFN,0),U)
- +15 ;
- +16 SET BMCCHSCT=+$PIECE($GET(^BMCREF(BMCRIEN,11)),U,15)
- +17 ;4.0 FCJ
- SET BMCSUF=$PIECE($GET(^BMCREF(BMCRIEN,1)),U)
- +18 ;
- +19 NEW Y
- +20 SET Y=BMCRDATE
- +21 DO DD^%DT
- +22 SET BMCREC("REF DATE")=Y
- +23 QUIT
- +24 ;
- +25 ;
- +26 ;
- SETCA ;EP - trigger the CHS APPROVAL STATUS AUDIT multiple from
- +1 ;call fileman with a xbnew call
- +2 NEW BMCCA
- +3 SET BMCCA("DA")=DA
- SET BMCCA("NEW")=$SELECT($GET(BMCNEWV)]"":BMCNEWV,1:X)
- SET BMCCA("OLD")=$SELECT($GET(BMCOLDV)]"":BMCOLDV,$DATA(D):$PIECE(D,U,12),1:"")
- SET BMCCA("OPT")=$PIECE($GET(XQY0),U)
- +4 ;don't update audit if values are the same
- IF BMCCA("NEW")=BMCCA("OLD")
- KILL BMCCA
- QUIT
- +5 DO EN^XBNEW("SETCA1^BMCREF","BMCCA")
- +6 KILL BMCCA
- +7 QUIT
- SETCA1 ;EP entry point for XBNEW
- +1 SET DA=BMCCA("DA")
- +2 SET DIADD=1
- SET DIE="^BMCREF("
- SET DR="4200///NOW"
- SET DR(2,90001.42)=".02////^S X=DUZ;.04///"_$GET(BMCCA("OLD"))_";.05///"_$GET(BMCCA("NEW"))_";.03///"_$SELECT(BMCCA("OPT")]"":BMCCA("OPT"),1:"UNKNOWN")
- DO ^DIE
- KILL DIE,DA,DR,DIADD
- +3 QUIT
- KILLCA ;EP trigger the CHS APPROVAL STATUS AUDIT multiple
- +1 ;from the kill side of CHS APPROVAL STATUS xref AAS
- +2 ;if this is not a delete just quit and set on set side
- +3 ;this is a change or add
- IF $PIECE($GET(^BMCREF(DA,11)),U,12)]""
- QUIT
- +4 NEW BMCCA
- +5 SET BMCCA("DA")=DA
- SET BMCCA("OLD")=X
- SET BMCCA("NEW")=""
- +6 DO EN^XBNEW("SETCA1^BMCREF","BMCCA")
- +7 KILL BMCCA
- +8 QUIT