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

GECSTRAN.m

Go to the documentation of this file.
  1. GECSTRAN ;WISC/RFJ/KLD-transmit a batch ;01 Nov 93
  1. ;;2.0;GCS;**13,15,20**;MAR 14, 1995
  1. N %,%X,CODE,D,DOMAIN,DA,GECS,GECSBADA,GECSBATC,GECSCODE,GECSDICS,GECSLINE,GECSMAX,GECSMSG,GECSXMY,GECSSYDA,GECSTOTL,GECSXMZ,PRIORITY,X,Y
  1. D ^GECSSITE Q:'$G(GECS("SITE"))
  1. D BATNOFMS^GECSUSEL Q:'$G(GECS("BATDA"))
  1. S GECS("SITECOM")=GECS("SITE")_GECS("SITE1")
  1. S GECSDICS="S %=^(0) I $S($P(%,""-"",1)=GECS(""SITECOM"")&($P(^(0),U,6)=GECS(""BATDA"")):1,1:0)"
  1. W ! S GECSBADA=$$BATCHSEL^GECSUSEL(GECSDICS) Q:'GECSBADA
  1. S GECSBATC=$P($G(^GECS(2101.3,GECSBADA,0)),"^") I GECSBATC="" W !,"CANNOT FIND BATCH NUMBER IN FILE 2101.3." Q
  1. ;
  1. ; build receiving users for mail messages
  1. K GECSXMY
  1. S %=0 F S %=$O(^GECS(2101.1,GECS("BATDA"),2,%)) Q:'% S D=$G(^(%,0)) I $P(D,"^",3)=1 D
  1. . S DOMAIN=$P($G(^DIC(4.2,+$P(D,"^",2),0)),"^") I DOMAIN'="" S DOMAIN="@"_DOMAIN
  1. . S GECSXMY($P(D,"^")_DOMAIN)=""
  1. I '$D(GECSXMY) W !,"RECEIVING USERS FOR THIS BATCH TYPE HAVE NOT BEEN ENTERED." Q
  1. W !!,"Transmission will be to the following:"
  1. S %="" F S %=$O(GECSXMY(%)) Q:%="" W !?5,%
  1. ;
  1. ;
  1. RETRY ; if locked, come here to retry transmission
  1. S XP="ARE YOU READY TO TRANSMIT THE CODE SHEETS",XH="Enter YES to transmit the code sheets, NO or ^ to exit." W ! I $$YN^GECSUTIL(2)'=1 Q
  1. ;
  1. ; check lock and lock system
  1. S GECSSYDA=$$LOCKSYS^GECSULOC(GECS("SITE")_"-"_GECS("SYSID")_"-TRANSMIT")
  1. I 'GECSSYDA W !!,"ANOTHER USER IS TRANSMITTING THE CODE SHEETS, TRY AGAIN IN A MINUTE" G RETRY
  1. ;
  1. ; check to see if batch has been transmitted, if so quit
  1. I $P($G(^GECS(2101.3,GECSBADA,0)),"^",3)'="B" D UNLOCK^GECSULOC(GECSSYDA) Q
  1. ;
  1. ; get maximum number of code sheets per message
  1. S GECSMAX=$P($G(^GECS(2101.1,GECS("BATDA"),0)),"^",3) I 'GECSMAX S GECSMAX=999999999
  1. ;
  1. ; build priority list
  1. K ^TMP($J,"GECSTRAN")
  1. S DA=0 F S DA=$O(^GECS(2100,"AB",GECSBATC,DA)) Q:'DA I $O(^GECS(2100,DA,"CODE",0)) S D=$G(^GECS(2100,DA,"TRANS")) I D'="" D
  1. . S PRIORITY=$P(D,"^",10) S:'PRIORITY PRIORITY=3
  1. . S ^TMP($J,"GECSTRAN",PRIORITY,DA)=""
  1. ;
  1. ; build messages
  1. K ^TMP($J,"GECSTRAN MM")
  1. S (GECSMSG,GECSLINE)=1
  1. S PRIORITY=0 F S PRIORITY=$O(^TMP($J,"GECSTRAN",PRIORITY)) Q:'PRIORITY S (DA,GECSCODE)=0 F S DA=$O(^TMP($J,"GECSTRAN",PRIORITY,DA)) Q:'DA D
  1. . ;
  1. . ; umark code sheet for transmission
  1. . S $P(^GECS(2100,DA,"TRANS"),"^",2)="" K ^GECS(2100,"AE","Y",DA)
  1. . ;
  1. . S GECSCODE=GECSCODE+1
  1. . I GECSCODE>GECSMAX S GECSMSG=GECSMSG+1,(GECSCODE,GECSLINE)=1
  1. . ;
  1. . ; special code to create calm header for fee code sheets 994.xx
  1. . I $P(GECSBATC,"-",2)="FEN",GECSLINE=1 D
  1. . . S %=$P(GECSBATC,"-",4)
  1. . . N Y,X
  1. . . S Y=DT D DD^%DT
  1. . . S ^TMP($J,"GECSTRAN MM",GECSMSG,GECSLINE,0)=$E($G(^GECS(2100,DA,"CODE",1,0)),1,3)_"."_$P(GECSBATC,"-")_".999.01."_$E(DT,4,7)_$E(DT,2,3)_".06"_$E("0000",$L(%)+1,4)_%_".$",GECSLINE=GECSLINE+1
  1. . S %=0 F S %=$O(^GECS(2100,DA,"CODE",%)) Q:'% S CODE=$G(^(%,0)) I CODE'="" D
  1. . . S ^TMP($J,"GECSTRAN MM",GECSMSG,GECSLINE,0)=CODE,GECSLINE=GECSLINE+1
  1. ;
  1. S GECSTOTL=GECSMSG
  1. ; transmit
  1. W !
  1. S GECSMSG=0 F S GECSMSG=$O(^TMP($J,"GECSTRAN MM",GECSMSG)) Q:'GECSMSG D
  1. . ;create mailman message
  1. . W !,"MESSAGE NUMBER: "
  1. . S GECSXMZ=$$MAILMSG(GECS("BATCH"),GECSBATC,.GECSXMY,GECSMSG,GECSTOTL)
  1. . W GECSXMZ
  1. . I 'GECSXMZ Q
  1. . ;
  1. . ; set message number in batch
  1. . D SETMSG(GECSBADA,GECSXMZ)
  1. ;
  1. ; update file 2101.3
  1. D UPDATE(GECSBADA)
  1. Q
  1. ;
  1. ;
  1. MAILMSG(BATCHNME,BATCHNUM,RECUSERS,MSGNUMBR,TOTALMSG) ; create mailman msg
  1. ; batchnme=name of batch
  1. ; batchnum=batch number
  1. ; recusers()=array of receiving users (same as xmy)
  1. ; msgnumbr=this message number
  1. ; totalmsg=total number of messages to transmit in all
  1. ; returns xmz message number
  1. N %,DIC,XCNP,XMDISPI,XMDUZ,XMTEXT,XMY,XMZ
  1. ;
  1. ; build receiving queue and user array
  1. S %="" F S %=$O(RECUSERS(%)) Q:%="" S XMY(%)=""
  1. S XMY(DUZ)="",XMDUZ=DUZ
  1. ;
  1. S XMTEXT="^TMP($J,""GECSTRAN MM"","_MSGNUMBR_",",XMSUB="GECS "_BATCHNME_" # "_BATCHNUM_" (MSG "_MSGNUMBR_" OF "_TOTALMSG_")"
  1. K XMZ D ^XMD
  1. Q $G(XMZ)
  1. ;
  1. ;
  1. UPDATE(DA) ; update file 2101.3 batch as being transmitted
  1. N %DT,D,D0,DI,DIC,DIE,DQ,DR,X,Y
  1. S (DIC,DIE)="^GECS(2101.3,",DR=".5///T;4///T;5////"_DUZ D ^DIE
  1. Q
  1. ;
  1. ;
  1. SETMSG(DA,XMZ) ; set message number in batch
  1. N %,D0,DD,DIC,DLAYGO,X,Y
  1. I '$D(^GECS(2101.3,DA,0)) Q
  1. S:'$D(^GECS(2101.3,DA,2,0)) ^(0)="^2101.32^^"
  1. S DIC="^GECS(2101.3,"_DA_",2,",DIC(0)="L",DLAYGO=2101.3,X=XMZ D FILE^DICN
  1. Q