- XQABELOG ;ISC-SF/JLI-LOG ALPHA/BETA ERRORS RECEIVED ;12/16/93 13:59 ; [ 04/02/2003 8:29 AM ]
- ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- ;;8.0;KERNEL;;Jul 10, 1995
- EN ;
- S XQAI1=.999,XQAUCI="" I $D(^XMB(3.9,XMZ,2,1,0)),$L(^(0))'>10 S XQAUCI="("_^(0)_")",XQAI1=1
- S XMFROM=$S(XMFROM["@":$P(XMFROM,"@",2),1:$P(^DIC(4.2,+^XTV(8989.3,1,0),0),U)) S:XMFROM[".VA.GOV" XMFROM=$P(XMFROM,".VA.GOV") S:XQAUCI="" XQAUCI="UNK.UCI"
- F XQAI=XQAI1:0 S XQAI=$O(^XMB(3.9,XMZ,2,XQAI)) Q:XQAI'>0 S XQAX=^(XQAI,0) D ADD
- K DA,DIC,DIE,DLAYGO,DR,XMFROM,XMZ,X,XQAI,XQAI1,XQAJ,XQAUCI,XQAX,XQAX1,XQAX1A,XQAX1B,XQAX2,XQAXD,XQAXN
- Q
- ;
- ADD I XQAX'[" ^" S XQAX1=$L(XQAX,"^"),XQAX=$P(XQAX,"^",1,XQAX1-1)_" ^"_$P(XQAX,"^",XQAX1)
- S XQAX1=$P(XQAX," ^")_" ",XQAX1A=$S(XQAX1["^":$P(XQAX1,"^")_"~"_$P(XQAX1,"^",2),1:XQAX1),XQAX1B=$S(XQAX1["^":$P($P(XQAX1,"^",2),":"),1:" ")
- S XQAX2=$P(XQAX," ^",2) F Q:$E(XQAX2)'=" " S XQAX2=$E(XQAX2,2,255)
- S XQAXD=+XQAX2,XQAX2=$E(XQAX2,8,200) F Q:$E(XQAX2)'=" " S XQAX2=$E(XQAX2,2,200)
- S XQAXN=+XQAX2 F Q:XQAX2="" Q:$E(XQAX2)=" " S XQAX2=$E(XQAX2,2,200)
- S XQAOPT=XQAX2 F Q:$E(XQAOPT)'=" " S XQAOPT=$E(XQAOPT,2,200)
- S X=$E(XQAX1A,1,30)_";"_$E(XQAOPT,1,30),DIC(0)="L",DIC="^XTV(8991.5,",DLAYGO=8991.5 D ^DIC Q:Y'>0 S DA=+Y,DR=".02///"_XQAX1B_";.03///"_XQAX1A_";"_$S(XQAOPT="":"",1:".04///"_XQAOPT),DIE=DIC D ^DIE S DA(1)=DA
- K DIC,DIE S DIC(0)="L",DLAYGO=8991.5,DIC="^XTV(8991.5,DA(1),1," S:'$D(@(DIC_"0)")) @(DIC_"0)")="^8991.51DA" S X=XQAXD D ^DIC Q:Y'>0 S DA(2)=DA(1),DA(1)=+Y
- K DIC S DIC(0)="L",DLAYGO=8991.5,DIC="^XTV(8991.5,DA(2),1,DA(1),1," S:'$D(@(DIC_"0)")) @(DIC_"0)")="^8991.511A" S X=XMFROM D ^DIC Q:Y'>0
- S DA(3)=DA(2),DA(2)=DA(1),DA(1)=+Y S DIC="^XTV(8991.5,DA(3),1,DA(2),1,DA(1),1," S:'$D(@(DIC_"0)")) @(DIC_"0)")="^8991.5111A" S X=XQAUCI D ^DIC Q:Y'>0
- S DA=+Y,DIE=DIC,DR=".02///"_XQAXN_";" D ^DIE K DIC,DIE
- Q
- XQABELOG ;ISC-SF/JLI-LOG ALPHA/BETA ERRORS RECEIVED ;12/16/93 13:59 ; [ 04/02/2003 8:29 AM ]
- +1 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- +2 ;;8.0;KERNEL;;Jul 10, 1995
- EN ;
- +1 SET XQAI1=.999
- SET XQAUCI=""
- IF $DATA(^XMB(3.9,XMZ,2,1,0))
- IF $LENGTH(^(0))'>10
- SET XQAUCI="("_^(0)_")"
- SET XQAI1=1
- +2 SET XMFROM=$SELECT(XMFROM["@":$PIECE(XMFROM,"@",2),1:$PIECE(^DIC(4.2,+^XTV(8989.3,1,0),0),U))
- IF XMFROM[".VA.GOV"
- SET XMFROM=$PIECE(XMFROM,".VA.GOV")
- IF XQAUCI=""
- SET XQAUCI="UNK.UCI"
- +3 FOR XQAI=XQAI1:0
- SET XQAI=$ORDER(^XMB(3.9,XMZ,2,XQAI))
- IF XQAI'>0
- QUIT
- SET XQAX=^(XQAI,0)
- DO ADD
- +4 KILL DA,DIC,DIE,DLAYGO,DR,XMFROM,XMZ,X,XQAI,XQAI1,XQAJ,XQAUCI,XQAX,XQAX1,XQAX1A,XQAX1B,XQAX2,XQAXD,XQAXN
- +5 QUIT
- +6 ;
- ADD IF XQAX'[" ^"
- SET XQAX1=$LENGTH(XQAX,"^")
- SET XQAX=$PIECE(XQAX,"^",1,XQAX1-1)_" ^"_$PIECE(XQAX,"^",XQAX1)
- +1 SET XQAX1=$PIECE(XQAX," ^")_" "
- SET XQAX1A=$SELECT(XQAX1["^":$PIECE(XQAX1,"^")_"~"_$PIECE(XQAX1,"^",2),1:XQAX1)
- SET XQAX1B=$SELECT(XQAX1["^":$PIECE($PIECE(XQAX1,"^",2),":"),1:" ")
- +2 SET XQAX2=$PIECE(XQAX," ^",2)
- FOR
- IF $EXTRACT(XQAX2)'=" "
- QUIT
- SET XQAX2=$EXTRACT(XQAX2,2,255)
- +3 SET XQAXD=+XQAX2
- SET XQAX2=$EXTRACT(XQAX2,8,200)
- FOR
- IF $EXTRACT(XQAX2)'=" "
- QUIT
- SET XQAX2=$EXTRACT(XQAX2,2,200)
- +4 SET XQAXN=+XQAX2
- FOR
- IF XQAX2=""
- QUIT
- IF $EXTRACT(XQAX2)=" "
- QUIT
- SET XQAX2=$EXTRACT(XQAX2,2,200)
- +5 SET XQAOPT=XQAX2
- FOR
- IF $EXTRACT(XQAOPT)'=" "
- QUIT
- SET XQAOPT=$EXTRACT(XQAOPT,2,200)
- +6 SET X=$EXTRACT(XQAX1A,1,30)_";"_$EXTRACT(XQAOPT,1,30)
- SET DIC(0)="L"
- SET DIC="^XTV(8991.5,"
- SET DLAYGO=8991.5
- DO ^DIC
- IF Y'>0
- QUIT
- SET DA=+Y
- SET DR=".02///"_XQAX1B_";.03///"_XQAX1A_";"_$SELECT(XQAOPT="":"",1:".04///"_XQAOPT)
- SET DIE=DIC
- DO ^DIE
- SET DA(1)=DA
- +7 KILL DIC,DIE
- SET DIC(0)="L"
- SET DLAYGO=8991.5
- SET DIC="^XTV(8991.5,DA(1),1,"
- IF '$DATA(@(DIC_"0)"))
- SET @(DIC_"0)")="^8991.51DA"
- SET X=XQAXD
- DO ^DIC
- IF Y'>0
- QUIT
- SET DA(2)=DA(1)
- SET DA(1)=+Y
- +8 KILL DIC
- SET DIC(0)="L"
- SET DLAYGO=8991.5
- SET DIC="^XTV(8991.5,DA(2),1,DA(1),1,"
- IF '$DATA(@(DIC_"0)"))
- SET @(DIC_"0)")="^8991.511A"
- SET X=XMFROM
- DO ^DIC
- IF Y'>0
- QUIT
- +9 SET DA(3)=DA(2)
- SET DA(2)=DA(1)
- SET DA(1)=+Y
- SET DIC="^XTV(8991.5,DA(3),1,DA(2),1,DA(1),1,"
- IF '$DATA(@(DIC_"0)"))
- SET @(DIC_"0)")="^8991.5111A"
- SET X=XQAUCI
- DO ^DIC
- IF Y'>0
- QUIT
- +10 SET DA=+Y
- SET DIE=DIC
- SET DR=".02///"_XQAXN_";"
- DO ^DIE
- KILL DIC,DIE
- +11 QUIT