BMCSMC.m

BMCSMC ; IHS/PHXAO/TMJ - calls from screenman screens ;

 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 ;Routine controls the data entry field deletions & required field

 ;controls - POSTCTR - Add Referral & POSTCTRM - Modify Referral

 ;

POSTCTR ;EP called from post action on change of type of referral

 NEW BMCI,BMCV

 S BMCV=X

 I BMCV="I" F BMCI=.07,.09,.23 D PUT^DDSVAL(90001,DA,BMCI,"")

 I BMCV="N" F BMCI=.07,.08 D PUT^DDSVAL(90001,DA,BMCI,"")

 I BMCV="C" F BMCI=.08,.23 D PUT^DDSVAL(90001,DA,BMCI,"")

 I BMCV="O" F BMCI=.08,.23 D PUT^DDSVAL(90001,DA,BMCI,"")

 D REQ^DDSUTL(1,1,1.2,0)

 D REQ^DDSUTL(2,1,1.2,0)

 D REQ^DDSUTL(1,1,1.3,0)

 D REQ^DDSUTL(1,1,1.4,0)

 D REQ^DDSUTL("PRIORITY",3,1,0)

 I BMCV="C" D REQ^DDSUTL(1,1,1.2,1)

 I BMCV="I" D REQ^DDSUTL(1,1,1.4,1)

 I BMCV="N" D REQ^DDSUTL(1,1,1.3,1)

 ;I BMCV="O" D REQ^DDSUTL(2,1,1.2,1)

 I BMCV="C"!($G(BMCPRIO)) D REQ^DDSUTL("PRIORITY",3,1,1)

 Q

POSTCTRM ;EP called from post action on modify type of referral

 NEW BMCV

 S BMCV=X

 I BMCV="I" F BMCI=.07,.09,.23 D PUT^DDSVAL(90001,DA,BMCI,"")

 I BMCV="N" F BMCI=.07,.08 D PUT^DDSVAL(90001,DA,BMCI,"")

 I BMCV="C" F BMCI=.08,.23 D PUT^DDSVAL(90001,DA,BMCI,"")

 I BMCV="O" F BMCI=.08,.23 D PUT^DDSVAL(90001,DA,BMCI,"")

 D REQ^DDSUTL(1,1,1.2,0)

 D REQ^DDSUTL(2,1,1.2,0)

 D REQ^DDSUTL(1,1,1.3,0)

 D REQ^DDSUTL(1,1,1.4,0)

 D REQ^DDSUTL("PRIORITY",2,1,0)

 I BMCV="C" D REQ^DDSUTL(1,1,1.2,1)

 I BMCV="I" D REQ^DDSUTL(1,1,1.4,1)

 I BMCV="N" D REQ^DDSUTL(1,1,1.3,1)

 ;I BMCV="O" D REQ^DDSUTL(2,1,1.2,1)

 I BMCV="C"!($G(BMCPRIO)) D REQ^DDSUTL("PRIORITY",2,1,1)

 Q

FACREF ;EP - called to set caption for prov ref to

 S Y=$S($$GET^DDSVAL(90001,.DA,.09,"","I"):$$GET^DDSVAL(90001,.DA,.09,"","E"),$$GET^DDSVAL(90001,.DA,.07,"","I"):$$GET^DDSVAL(90001,.DA,.07,"","E"),$$GET^DDSVAL(90001,.DA,.08,"","I"):$$GET^DDSVAL(90001,.DA,.08,"","E"),1:"")

 Q:Y]""

 S Y=$$GET^DDSVAL(90001,.DA,.23,"","E")

 Q

 N X

PRECTRM ; EP called from pre action on BMC REFERRAL EDIT BLK 1

 ;

 ; determine whether REFERRAL TYPE field can be edited or not.

 ; if referral type is CHS and CHS authorizations exist, it cannot

 ; be modified.

 ;

 S X=BMCRTYPE

 D UNED^DDSUTL("REFERRAL TYPE",2,1,0)

 I X="C"&(BMCCHSCT>0) D UNED^DDSUTL("REFERRAL TYPE",2,1,2)

 Q

BMCSMC    ; IHS/PHXAO/TMJ - calls from screenman screens ;

 +1       ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 +2       ;Routine controls the data entry field deletions & required field

 +3       ;controls - POSTCTR - Add Referral & POSTCTRM - Modify Referral

 +4       ;

POSTCTR   ;EP called from post action on change of type of referral

 +1        NEW BMCI,BMCV

 +2        SET BMCV=X

 +3        IF BMCV="I"

               FOR BMCI=.07,.09,.23

                   DO PUT^DDSVAL(90001,DA,BMCI,"")

 +4        IF BMCV="N"

               FOR BMCI=.07,.08

                   DO PUT^DDSVAL(90001,DA,BMCI,"")

 +5        IF BMCV="C"

               FOR BMCI=.08,.23

                   DO PUT^DDSVAL(90001,DA,BMCI,"")

 +6        IF BMCV="O"

               FOR BMCI=.08,.23

                   DO PUT^DDSVAL(90001,DA,BMCI,"")

 +7        DO REQ^DDSUTL(1,1,1.2,0)

 +8        DO REQ^DDSUTL(2,1,1.2,0)

 +9        DO REQ^DDSUTL(1,1,1.3,0)

 +10       DO REQ^DDSUTL(1,1,1.4,0)

 +11       DO REQ^DDSUTL("PRIORITY",3,1,0)

 +12       IF BMCV="C"

               DO REQ^DDSUTL(1,1,1.2,1)

 +13       IF BMCV="I"

               DO REQ^DDSUTL(1,1,1.4,1)

 +14       IF BMCV="N"

               DO REQ^DDSUTL(1,1,1.3,1)

 +15      ;I BMCV="O" D REQ^DDSUTL(2,1,1.2,1)

 +16       IF BMCV="C"!($GET(BMCPRIO))

               DO REQ^DDSUTL("PRIORITY",3,1,1)

 +17       QUIT 

POSTCTRM  ;EP called from post action on modify type of referral

 +1        NEW BMCV

 +2        SET BMCV=X

 +3        IF BMCV="I"

               FOR BMCI=.07,.09,.23

                   DO PUT^DDSVAL(90001,DA,BMCI,"")

 +4        IF BMCV="N"

               FOR BMCI=.07,.08

                   DO PUT^DDSVAL(90001,DA,BMCI,"")

 +5        IF BMCV="C"

               FOR BMCI=.08,.23

                   DO PUT^DDSVAL(90001,DA,BMCI,"")

 +6        IF BMCV="O"

               FOR BMCI=.08,.23

                   DO PUT^DDSVAL(90001,DA,BMCI,"")

 +7        DO REQ^DDSUTL(1,1,1.2,0)

 +8        DO REQ^DDSUTL(2,1,1.2,0)

 +9        DO REQ^DDSUTL(1,1,1.3,0)

 +10       DO REQ^DDSUTL(1,1,1.4,0)

 +11       DO REQ^DDSUTL("PRIORITY",2,1,0)

 +12       IF BMCV="C"

               DO REQ^DDSUTL(1,1,1.2,1)

 +13       IF BMCV="I"

               DO REQ^DDSUTL(1,1,1.4,1)

 +14       IF BMCV="N"

               DO REQ^DDSUTL(1,1,1.3,1)

 +15      ;I BMCV="O" D REQ^DDSUTL(2,1,1.2,1)

 +16       IF BMCV="C"!($GET(BMCPRIO))

               DO REQ^DDSUTL("PRIORITY",2,1,1)

 +17       QUIT 

FACREF    ;EP - called to set caption for prov ref to

 +1        SET Y=$SELECT($$GET^DDSVAL(90001,.DA,.09,"","I"):$$GET^DDSVAL(90001,.DA,.09,"","E"),$$GET^DDSVAL(90001,.DA,.07,"","I"):$$GET^DDSVAL(90001,.DA,.07,"","E"),$$GET^DDSVAL(90001,.DA,.08,"","I"):$$GET^DDSVAL(90001,.DA,.08,"","E"),1:"")

 +2        IF Y]""

               QUIT 

 +3        SET Y=$$GET^DDSVAL(90001,.DA,.23,"","E")

 +4        QUIT 

 +5        NEW X

PRECTRM   ; EP called from pre action on BMC REFERRAL EDIT BLK 1

 +1       ;

 +2       ; determine whether REFERRAL TYPE field can be edited or not.

 +3       ; if referral type is CHS and CHS authorizations exist, it cannot

 +4       ; be modified.

 +5       ;

 +6        SET X=BMCRTYPE

 +7        DO UNED^DDSUTL("REFERRAL TYPE",2,1,0)

 +8        IF X="C"&(BMCCHSCT>0)

               DO UNED^DDSUTL("REFERRAL TYPE",2,1,2)

 +9        QUIT