ASUWSND1 ; IHS/ITSC/LMH - SAMS DATA TRANSMISSION ROUTINE - SEND DATA ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;;Y2K/OK AEF/2970903
;
;THIS ROUTINE IS UNDER DEVELOPMENT
;This routine is used by SAMS to transmit data from sites to the
;national repository database
;
EN ;EP -- MAIN ENTRY POINT TO TRANSMIT NEW SAMS TRANSACTIONS
;
N ASUTRANS,ASUXMZ,X,Y
D ^XBKVAR
Q:'$D(^ASUW(9002036.88,"ATRANS",1))
D TRANS(.ASUTRANS)
Q:ASUTRANS'>0
D MSG(.ASUXMZ,ASUTRANS)
Q:ASUXMZ'>0
D GET(ASUXMZ)
D SEND(ASUXMZ)
D MARK(ASUTRANS)
G QUIT
Q
EN2 ;EP -- ENTRY POINT TO RETRANSMIT SAMS TRANSACTIONS
;
;NOTE: DON'T CREATE ENTRY IN ASUW TRANSMISSION STATISTICS FILE
; UNLESS AN ENTRY IS FOUND WHICH HAS BEEN TRANSMITTED FOR A WHILE
; BUT NO CONFIRMATION HAS BEEN RECEIVED
;
N ASUTRANS,ASUXMZ
D ^XBKVAR
Q:'$D(ASUW(9002036.88,"ATRANS",2))
Q
MSG(X,Y) ;----- CREATE MAIL MESSAGE STUB
;
N XMSUB,XMDUZ,XMZ
S XMSUB=$$SITE_"\"_DT_"\"_Y_"\"_"SAMS DATA TRANSMISSION"
S XMDUZ="SAMS PACKAGE"
D XMZ^XMA2
S X=XMZ
Q
GET(XMZ) ;----- GET DATA AND STUFF INTO MAIL MESSAGE
;
;NOTE: SHOULD I LIMIT MESSAGE TO A PARTICULAR NUMBER OF RECORDS?
;
; ASUL = mail message line counter
; ASUWN = node
; ASUR = record count
; ASUX = record number
;
N ASUDATA,ASUL,ASUWN,ASUR,ASUX
K ^TMP("ASU",$J,"X")
S ASUL=1,ASUR=0
S ^XMB(3.9,XMZ,2,ASUL,0)="$$START"
S ASUX=0 F S ASUX=$O(^ASUW(9002036.88,"ATRANS",1,ASUX)) Q:'ASUX D
. S ASUR=ASUR+1
. F ASUWN=0,1,3,4,5 D
. . S ASUL=ASUL+1
. . S ASUDATA=$G(^ASUW(9002036.88,ASUX,ASUWN))
. . I $P(ASUDATA,U,6) S $P(ASUDATA,U,6)=$P($G(^VA(200,$P(ASUDATA,U,6),0)),U)
. . I $P(ASUDATA,U,18) S $P(ASUDATA,U,18)=$P($G(^AUTTVNDR($P(ASUDATA,U,18),0)),U)
. . S ^XMB(3.9,XMZ,2,ASUL,0)=ASUR_ASUWN_U_ASUDATA
. S ^TMP("ASU",$J,"X",ASUX,0)=XMZ_U_DT
S ASUL=ASUL+1
S ^XMB(3.9,XMZ,2,ASUL,0)="$$END"
S ^XMB(3.9,XMZ,2,0)="^3.92^"_ASUL_U_ASUL_U_DT
Q
SEND(XMZ) ;
;----- SEND MAIL MESSAGE
;
N XMDUN,XMY
S XMDUN="SAMS PACKAGE"
S XMY("DOE,MARY@TST.DSD-ALB1.DOMAIN.NAME")=""
D ENT1^XMD
Q
MARK(ASUTRANS) ;
;----- MARK FILE ENTRIES TRANSMITTED
;
N ASUDT,ASUMSG,ASUX,DA,DD,DIC,DIE,DLAYGO,DO,DR,X,Y
S ASUX=0 F S ASUX=$O(^TMP("ASU",$J,"X",ASUX)) Q:'ASUX D
. S ASUMSG=^TMP("ASU",$J,"X",ASUX,0)
. S ASUDT=$P(ASUMSG,U,2)
. S DIE="^ASUW(9002036.88,"
. S DA=ASUX
. S DR="9991///2;9992///^S X=ASUTRANS"
. D ^DIE
. K DA,DD,DIE,DO,DR,X,Y
. S DA(1)=ASUTRANS
. S DIC="^ASUW(9002036.77,"_DA(1)_",99,"
. S DIC(0)="L"
. S DIC("P")=$P(^DD(9002036.77,99,0),U,2)
. S DLAYGO=9002036.77
. S X=ASUX
. D FILE^DICN
K DA,DIE,DR,X,Y
S DIE="^ASUW(9002036.77,"
S DA=ASUTRANS
S DR=".02///^S X=ASUDT;.03///^S X=+ASUMSG"
D ^DIE
Q
SITE() ;----- GET SITE'S DOMAIN NAME
;
N X
S X=$P(^DIC(4.2,$P(^XMB(1,1,0),U),0),U)
Q X
TRANS(X) ;----- GET TRANSMISSION NUMBER
;
N D0,DA,DD,DI,DIC,DIE,DO,DQ,DR,Y
L +^ASUW(9002036.77,0):DTIME
S X=$P(^ASUW(9002036.77,0),U,3)
F X=X:1 Q:'$D(^ASUW(9002036.77,X))
K DD,DO
S DIC="^ASUW(9002036.77,",DIC(0)="",DA=X
S DIC("DR")=".02///^S X=DT"
D FILE^DICN
S X=+Y
L -^ASUW(9002036.77,0)
Q
QUIT ;----- CLEAN UP AND QUIT
;
K ^TMP("ASU",$J,"X")
Q
ASUWSND1 ; IHS/ITSC/LMH - SAMS DATA TRANSMISSION ROUTINE - SEND DATA ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;;Y2K/OK AEF/2970903
+3 ;
+4 ;THIS ROUTINE IS UNDER DEVELOPMENT
+5 ;This routine is used by SAMS to transmit data from sites to the
+6 ;national repository database
+7 ;
EN ;EP -- MAIN ENTRY POINT TO TRANSMIT NEW SAMS TRANSACTIONS
+1 ;
+2 NEW ASUTRANS,ASUXMZ,X,Y
+3 DO ^XBKVAR
+4 IF '$DATA(^ASUW(9002036.88,"ATRANS",1))
QUIT
+5 DO TRANS(.ASUTRANS)
+6 IF ASUTRANS'>0
QUIT
+7 DO MSG(.ASUXMZ,ASUTRANS)
+8 IF ASUXMZ'>0
QUIT
+9 DO GET(ASUXMZ)
+10 DO SEND(ASUXMZ)
+11 DO MARK(ASUTRANS)
+12 GOTO QUIT
+13 QUIT
EN2 ;EP -- ENTRY POINT TO RETRANSMIT SAMS TRANSACTIONS
+1 ;
+2 ;NOTE: DON'T CREATE ENTRY IN ASUW TRANSMISSION STATISTICS FILE
+3 ; UNLESS AN ENTRY IS FOUND WHICH HAS BEEN TRANSMITTED FOR A WHILE
+4 ; BUT NO CONFIRMATION HAS BEEN RECEIVED
+5 ;
+6 NEW ASUTRANS,ASUXMZ
+7 DO ^XBKVAR
+8 IF '$DATA(ASUW(9002036.88,"ATRANS",2))
QUIT
+9 QUIT
MSG(X,Y) ;----- CREATE MAIL MESSAGE STUB
+1 ;
+2 NEW XMSUB,XMDUZ,XMZ
+3 SET XMSUB=$$SITE_"\"_DT_"\"_Y_"\"_"SAMS DATA TRANSMISSION"
+4 SET XMDUZ="SAMS PACKAGE"
+5 DO XMZ^XMA2
+6 SET X=XMZ
+7 QUIT
GET(XMZ) ;----- GET DATA AND STUFF INTO MAIL MESSAGE
+1 ;
+2 ;NOTE: SHOULD I LIMIT MESSAGE TO A PARTICULAR NUMBER OF RECORDS?
+3 ;
+4 ; ASUL = mail message line counter
+5 ; ASUWN = node
+6 ; ASUR = record count
+7 ; ASUX = record number
+8 ;
+9 NEW ASUDATA,ASUL,ASUWN,ASUR,ASUX
+10 KILL ^TMP("ASU",$JOB,"X")
+11 SET ASUL=1
SET ASUR=0
+12 SET ^XMB(3.9,XMZ,2,ASUL,0)="$$START"
+13 SET ASUX=0
FOR
SET ASUX=$ORDER(^ASUW(9002036.88,"ATRANS",1,ASUX))
IF 'ASUX
QUIT
Begin DoDot:1
+14 SET ASUR=ASUR+1
+15 FOR ASUWN=0,1,3,4,5
Begin DoDot:2
+16 SET ASUL=ASUL+1
+17 SET ASUDATA=$GET(^ASUW(9002036.88,ASUX,ASUWN))
+18 IF $PIECE(ASUDATA,U,6)
SET $PIECE(ASUDATA,U,6)=$PIECE($GET(^VA(200,$PIECE(ASUDATA,U,6),0)),U)
+19 IF $PIECE(ASUDATA,U,18)
SET $PIECE(ASUDATA,U,18)=$PIECE($GET(^AUTTVNDR($PIECE(ASUDATA,U,18),0)),U)
+20 SET ^XMB(3.9,XMZ,2,ASUL,0)=ASUR_ASUWN_U_ASUDATA
End DoDot:2
+21 SET ^TMP("ASU",$JOB,"X",ASUX,0)=XMZ_U_DT
End DoDot:1
+22 SET ASUL=ASUL+1
+23 SET ^XMB(3.9,XMZ,2,ASUL,0)="$$END"
+24 SET ^XMB(3.9,XMZ,2,0)="^3.92^"_ASUL_U_ASUL_U_DT
+25 QUIT
SEND(XMZ) ;
+1 ;----- SEND MAIL MESSAGE
+2 ;
+3 NEW XMDUN,XMY
+4 SET XMDUN="SAMS PACKAGE"
+5 SET XMY("DOE,MARY@TST.DSD-ALB1.DOMAIN.NAME")=""
+6 DO ENT1^XMD
+7 QUIT
MARK(ASUTRANS) ;
+1 ;----- MARK FILE ENTRIES TRANSMITTED
+2 ;
+3 NEW ASUDT,ASUMSG,ASUX,DA,DD,DIC,DIE,DLAYGO,DO,DR,X,Y
+4 SET ASUX=0
FOR
SET ASUX=$ORDER(^TMP("ASU",$JOB,"X",ASUX))
IF 'ASUX
QUIT
Begin DoDot:1
+5 SET ASUMSG=^TMP("ASU",$JOB,"X",ASUX,0)
+6 SET ASUDT=$PIECE(ASUMSG,U,2)
+7 SET DIE="^ASUW(9002036.88,"
+8 SET DA=ASUX
+9 SET DR="9991///2;9992///^S X=ASUTRANS"
+10 DO ^DIE
+11 KILL DA,DD,DIE,DO,DR,X,Y
+12 SET DA(1)=ASUTRANS
+13 SET DIC="^ASUW(9002036.77,"_DA(1)_",99,"
+14 SET DIC(0)="L"
+15 SET DIC("P")=$PIECE(^DD(9002036.77,99,0),U,2)
+16 SET DLAYGO=9002036.77
+17 SET X=ASUX
+18 DO FILE^DICN
End DoDot:1
+19 KILL DA,DIE,DR,X,Y
+20 SET DIE="^ASUW(9002036.77,"
+21 SET DA=ASUTRANS
+22 SET DR=".02///^S X=ASUDT;.03///^S X=+ASUMSG"
+23 DO ^DIE
+24 QUIT
SITE() ;----- GET SITE'S DOMAIN NAME
+1 ;
+2 NEW X
+3 SET X=$PIECE(^DIC(4.2,$PIECE(^XMB(1,1,0),U),0),U)
+4 QUIT X
TRANS(X) ;----- GET TRANSMISSION NUMBER
+1 ;
+2 NEW D0,DA,DD,DI,DIC,DIE,DO,DQ,DR,Y
+3 LOCK +^ASUW(9002036.77,0):DTIME
+4 SET X=$PIECE(^ASUW(9002036.77,0),U,3)
+5 FOR X=X:1
IF '$DATA(^ASUW(9002036.77,X))
QUIT
+6 KILL DD,DO
+7 SET DIC="^ASUW(9002036.77,"
SET DIC(0)=""
SET DA=X
+8 SET DIC("DR")=".02///^S X=DT"
+9 DO FILE^DICN
+10 SET X=+Y
+11 LOCK -^ASUW(9002036.77,0)
+12 QUIT
QUIT ;----- CLEAN UP AND QUIT
+1 ;
+2 KILL ^TMP("ASU",$JOB,"X")
+3 QUIT
