Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ASUWSND1

ASUWSND1.m

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