ABMXUS9.m

ABMXUS9 ;IHS/SD/SDR - Find a user ;06/18/2007 08:45 

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

EP ;PEP -

 N %,%H,DA,DIC,I,Y,X,ABMXU1,ABMXU2,ABMXU3,ABMXU4,ABMXU5,ABMXU6

 N ABMXUSER,ABMXUJOB,ABMXUVOL,ABMXUCI,ABMXUDT

 K ABMOPFLG

1 X ^%ZOSF("UCI") S ABMXU1=$P(Y,",",1),ABMXU2=^%ZOSF("VOL"),X="T-1",%DT="" D ^%DT S ABMXU4=Y

A S DIC="^VA(200,"

 S DIC(0)="MQ"

 S X="`"_ABMDUZ

 D ^DIC

 G EXIT:Y'>0

 S DA=+Y,ABMXUSER=$P(Y,"^",2)

 F ABMXU5=0:0 S ABMXU5=$O(^XUSEC(0,"CUR",DA,ABMXU5)) Q:ABMXU5'>0  D B

 Q

EXIT ;K %,%H,DA,DIC,I,Y,X

EX2 ;K XU1,XU2,XU3,XU4,XU5,XU6,XUSER,XUJOB,XUVOL,XUCI,XUDT

 Q

B ;Find

 G:ABMXU5<ABMXU4 REMOVE ;Sign-on more than 24 hours old.

 S ABMXU3=$S($D(^XUSEC(0,ABMXU5,0)):^(0),1:"") G REMOVE:'$L(ABMXU3),REMOVE:$P(ABMXU3,"^",4)

 S ABMXUCI=$P(ABMXU3,"^",8),ABMXUVOL=$P(ABMXU3,"^",5),Y=ABMXU5,ABMXUJOB=$P(ABMXU3,"^",3),ABMXU6=ABMXUJOB D DD^%DT S ABMXUDT=Y

 I ABMXUJOB>2048 S X1=16,X=ABMXUJOB D CNV^XTBASE S ABMXU6=ABMXUJOB_" ("_Y_")"

 Q:ABMXUCI'=ABMXU1!(ABMXUVOL'=ABMXU2)  G:$S($D(^XUTL("XQ",ABMXUJOB,"DUZ")):^("DUZ"),1:0)'=DA REMOVE

 I $D(^XUTL("XQ",ABMXUJOB,"T")) D

 .S ABMOPTLS=999999999

 .F  S ABMOPTLS=$O(^XUTL("XQ",ABMXUJOB,ABMOPTLS),-1) Q:+ABMOPTLS=0  D  Q:$G(ABMOPFLG)=1

 ..I $P($G(^XUTL("XQ",ABMXUJOB,ABMOPTLS)),U,2)="ABMMENU" S ABMOPFLG=1

 Q

REMOVE ;Questionable entry removed

 ;If we have a sign-off time just remove the "CUR" X-ref.

 I $P($G(^XUSEC(0,ABMXU5,0)),"^",4) K ^XUSEC(0,"CUR",DA,ABMXU5) Q

 N FDA

 S FDA(3.081,ABMXU5_",",3)=$$NOW^XLFDT,FDA(3.081,ABMXU5_",",16)=1

 D UPDATE^DIE("","FDA")

 Q

INQ Q:'$D(D0)  N DA X ^%ZOSF("UCI") S ABMXU1=$P(Y,",",1),ABMXU2=^%ZOSF("VOL"),DA=D0,ABMXU4=DT-1

 F ABMXU5=0:0 S ABMXU5=$O(^XUSEC(0,"CUR",DA,ABMXU5)) Q:ABMXU5'>0  D B

 G EX2

ABMXUS9   ;IHS/SD/SDR - Find a user ;06/18/2007 08:45 

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

EP        ;PEP -

 +1        NEW %,%H,DA,DIC,I,Y,X,ABMXU1,ABMXU2,ABMXU3,ABMXU4,ABMXU5,ABMXU6

 +2        NEW ABMXUSER,ABMXUJOB,ABMXUVOL,ABMXUCI,ABMXUDT

 +3        KILL ABMOPFLG

1          XECUTE ^%ZOSF("UCI")

           SET ABMXU1=$PIECE(Y,",",1)

           SET ABMXU2=^%ZOSF("VOL")

           SET X="T-1"

           SET %DT=""

           DO ^%DT

           SET ABMXU4=Y

A          SET DIC="^VA(200,"

 +1        SET DIC(0)="MQ"

 +2        SET X="`"_ABMDUZ

 +3        DO ^DIC

 +4        IF Y'>0

               GOTO EXIT

 +5        SET DA=+Y

           SET ABMXUSER=$PIECE(Y,"^",2)

 +6        FOR ABMXU5=0:0

               SET ABMXU5=$ORDER(^XUSEC(0,"CUR",DA,ABMXU5))

               IF ABMXU5'>0

                   QUIT 

               DO B

 +7        QUIT 

EXIT      ;K %,%H,DA,DIC,I,Y,X

EX2       ;K XU1,XU2,XU3,XU4,XU5,XU6,XUSER,XUJOB,XUVOL,XUCI,XUDT

 +1        QUIT 

B         ;Find

 +1       ;Sign-on more than 24 hours old.

           IF ABMXU5<ABMXU4

               GOTO REMOVE

 +2        SET ABMXU3=$SELECT($DATA(^XUSEC(0,ABMXU5,0)):^(0),1:"")

           IF '$LENGTH(ABMXU3)

               GOTO REMOVE

           IF $PIECE(ABMXU3,"^",4)

               GOTO REMOVE

 +3        SET ABMXUCI=$PIECE(ABMXU3,"^",8)

           SET ABMXUVOL=$PIECE(ABMXU3,"^",5)

           SET Y=ABMXU5

           SET ABMXUJOB=$PIECE(ABMXU3,"^",3)

           SET ABMXU6=ABMXUJOB

           DO DD^%DT

           SET ABMXUDT=Y

 +4        IF ABMXUJOB>2048

               SET X1=16

               SET X=ABMXUJOB

               DO CNV^XTBASE

               SET ABMXU6=ABMXUJOB_" ("_Y_")"

 +5        IF ABMXUCI'=ABMXU1!(ABMXUVOL'=ABMXU2)

               QUIT 

           IF $SELECT($DATA(^XUTL("XQ",ABMXUJOB,"DUZ"))

               GOTO REMOVE

 +6        IF $DATA(^XUTL("XQ",ABMXUJOB,"T"))

               Begin DoDot:1

 +7                SET ABMOPTLS=999999999

 +8                FOR 

                       SET ABMOPTLS=$ORDER(^XUTL("XQ",ABMXUJOB,ABMOPTLS),-1)

                       IF +ABMOPTLS=0

                           QUIT 

                       Begin DoDot:2

 +9                        IF $PIECE($GET(^XUTL("XQ",ABMXUJOB,ABMOPTLS)),U,2)="ABMMENU"

                               SET ABMOPFLG=1

                       End DoDot:2

                       IF $GET(ABMOPFLG)=1

                           QUIT 

               End DoDot:1

 +10       QUIT 

REMOVE    ;Questionable entry removed

 +1       ;If we have a sign-off time just remove the "CUR" X-ref.

 +2        IF $PIECE($GET(^XUSEC(0,ABMXU5,0)),"^",4)

               KILL ^XUSEC(0,"CUR",DA,ABMXU5)

               QUIT 

 +3        NEW FDA

 +4        SET FDA(3.081,ABMXU5_",",3)=$$NOW^XLFDT

           SET FDA(3.081,ABMXU5_",",16)=1

 +5        DO UPDATE^DIE("","FDA")

 +6        QUIT 

INQ        IF '$DATA(D0)

               QUIT 

           NEW DA

           XECUTE ^%ZOSF("UCI")

           SET ABMXU1=$PIECE(Y,",",1)

           SET ABMXU2=^%ZOSF("VOL")

           SET DA=D0

           SET ABMXU4=DT-1

 +1        FOR ABMXU5=0:0

               SET ABMXU5=$ORDER(^XUSEC(0,"CUR",DA,ABMXU5))

               IF ABMXU5'>0

                   QUIT 

               DO B

 +2        GOTO EX2