- 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