- 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
