BMCREF.m

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