ABMUSETU ; IHS/SD/SDR - 3PB/UFMS Setup Option
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
; New routine - v2.5 p12 SDD item 4.9.2.7
EP ;
;Option to turn off UFMS export/cashiering if tribal
S ABMADIEN=$O(^AUTTLOC(DUZ(2),11,9999999),-1)
I +$G(ABMADIEN)=0 W !,"Affiliation has not been set up. Contact your site manager to add this entry",!,"to the Location file." H 2 Q
TRIBAL I $P($G(^AUTTLOC(DUZ(2),11,ABMADIEN,0)),U,3)'="1" D ;if affiliation anything but IHS
.K DIC,DIE,X,Y,DA
.S DIE="^ABMDPARM(DUZ(2),"
.S DA=1
.S DR="414"
.D ^DIE
.I ($P($G(^ABMDPARM(DUZ(2),1,4)),U,15)=1) D
..D FINDAOPN^ABMUCUTL
..I $D(ABMO) W !!,"PLEASE NOTE: YOU CURRENTLY HAVE OPEN SESSIONS ON YOUR SYSTEM!",! H 1
.S DR="415"
.D ^DIE
.I $P($G(^ABMDPARM(DUZ(2),1,4)),U,14)=1,($P($G(^ABMDPARM(DUZ(2),1,4)),U,15)=0) D
..W !!,"You have chosen not to do cashiering sessions (export files are created based on"
..W !,"these sessions). By not doing cashiering sessions, export files can not be"
..W !,"created."
..W !!,"If you continue, TPB will override the UFMS export to NO and data will NOT be"
..W !,"exported.",!
..K DIC,DIE,DIR,X,Y,DA
..S DIR(0)="Y",DIR("A")="Do you wish to continue" D ^DIR K DIR
..S ABMCANS=+Y
.;if yes to export, no to cashiering and no to continue
.I $P($G(^ABMDPARM(DUZ(2),1,4)),U,14)=1,($P($G(^ABMDPARM(DUZ(2),1,4)),U,15)=0),($G(ABMCANS)=0) G TRIBAL
.;if yes to export, no to cashiering and yes to continue
.I $P($G(^ABMDPARM(DUZ(2),1,4)),U,14)=1,($P($G(^ABMDPARM(DUZ(2),1,4)),U,15)=0),($G(ABMCANS)=1) D Q
..K DIC,DIE,X,Y,DA
..S DIE="^ABMDPARM(DUZ(2),"
..S DA=1
..S DR="414////0"
..D ^DIE
.;if no to export,yes to cashiering
.I $P($G(^ABMDPARM(DUZ(2),1,4)),U,14)=0,($P($G(^ABMDPARM(DUZ(2),1,4)),U,15)=1) D
..K DIC,DIE,X,Y,DA
..S DIE="^ABMDPARM(DUZ(2),"
..S DA=1
..S DR="416//5"
..D ^DIE
I $P($G(^AUTTLOC(DUZ(2),11,ABMADIEN,0)),U,3)="1"!($P($G(^ABMDPARM(DUZ(2),1,4)),U,14)=1) D
.K DIC,DIE,X,Y,DA
.S DIE="^ABMDPARM(DUZ(2),"
.S DA=1
.S DR="413;416//5;417"
.D ^DIE
;
I $P($G(^AUTTLOC(DUZ(2),11,ABMADIEN,0)),U,3)="1" D ^ABMUXCLD ;exclude tribal data
Q
ABMUSETU ; IHS/SD/SDR - 3PB/UFMS Setup Option
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ; New routine - v2.5 p12 SDD item 4.9.2.7
EP ;
+1 ;Option to turn off UFMS export/cashiering if tribal
+2 SET ABMADIEN=$ORDER(^AUTTLOC(DUZ(2),11,9999999),-1)
+3 IF +$GET(ABMADIEN)=0
WRITE !,"Affiliation has not been set up. Contact your site manager to add this entry",!,"to the Location file."
HANG 2
QUIT
TRIBAL ;if affiliation anything but IHS
IF $PIECE($GET(^AUTTLOC(DUZ(2),11,ABMADIEN,0)),U,3)'="1"
Begin DoDot:1
+1 KILL DIC,DIE,X,Y,DA
+2 SET DIE="^ABMDPARM(DUZ(2),"
+3 SET DA=1
+4 SET DR="414"
+5 DO ^DIE
+6 IF ($PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,15)=1)
Begin DoDot:2
+7 DO FINDAOPN^ABMUCUTL
+8 IF $DATA(ABMO)
WRITE !!,"PLEASE NOTE: YOU CURRENTLY HAVE OPEN SESSIONS ON YOUR SYSTEM!",!
HANG 1
End DoDot:2
+9 SET DR="415"
+10 DO ^DIE
+11 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,14)=1
IF ($PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,15)=0)
Begin DoDot:2
+12 WRITE !!,"You have chosen not to do cashiering sessions (export files are created based on"
+13 WRITE !,"these sessions). By not doing cashiering sessions, export files can not be"
+14 WRITE !,"created."
+15 WRITE !!,"If you continue, TPB will override the UFMS export to NO and data will NOT be"
+16 WRITE !,"exported.",!
+17 KILL DIC,DIE,DIR,X,Y,DA
+18 SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue"
DO ^DIR
KILL DIR
+19 SET ABMCANS=+Y
End DoDot:2
+20 ;if yes to export, no to cashiering and no to continue
+21 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,14)=1
IF ($PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,15)=0)
IF ($GET(ABMCANS)=0)
GOTO TRIBAL
+22 ;if yes to export, no to cashiering and yes to continue
+23 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,14)=1
IF ($PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,15)=0)
IF ($GET(ABMCANS)=1)
Begin DoDot:2
+24 KILL DIC,DIE,X,Y,DA
+25 SET DIE="^ABMDPARM(DUZ(2),"
+26 SET DA=1
+27 SET DR="414////0"
+28 DO ^DIE
End DoDot:2
QUIT
+29 ;if no to export,yes to cashiering
+30 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,14)=0
IF ($PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,15)=1)
Begin DoDot:2
+31 KILL DIC,DIE,X,Y,DA
+32 SET DIE="^ABMDPARM(DUZ(2),"
+33 SET DA=1
+34 SET DR="416//5"
+35 DO ^DIE
End DoDot:2
End DoDot:1
+36 IF $PIECE($GET(^AUTTLOC(DUZ(2),11,ABMADIEN,0)),U,3)="1"!($PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,14)=1)
Begin DoDot:1
+37 KILL DIC,DIE,X,Y,DA
+38 SET DIE="^ABMDPARM(DUZ(2),"
+39 SET DA=1
+40 SET DR="413;416//5;417"
+41 DO ^DIE
End DoDot:1
+42 ;
+43 ;exclude tribal data
IF $PIECE($GET(^AUTTLOC(DUZ(2),11,ABMADIEN,0)),U,3)="1"
DO ^ABMUXCLD
+44 QUIT
