SROATMIT.m

SROATMIT ;BIR/MAM - STUFF TRANMISSION IN ^TMP ;03/22/06

 ;;3.0; Surgery ;**18,27,38,55,62,68,153**;24 Jun 93;Build 11

 ;** NOTICE: This routine is part of an implementation of a nationally

 ;**         controlled procedure. Local modifications to this routine

 ;**         are prohibited.

 ;

 K ^TMP("SRA",$J),^TMP("SRAMSG",$J),^TMP("SRWL",$J) S SRATOT=0,SRASITE=+$P($$SITE^SROVAR,"^",3),(SRAMNUM,SRACNT)=1

 S SRADFN=0 F  S SRADFN=$O(^SRF("ARS","N","I",SRADFN)) Q:'SRADFN  S SRTN=0 F  S SRTN=$O(^SRF("ARS","N","I",SRADFN,SRTN)) Q:'SRTN  S SR("RA")=$G(^SRF(SRTN,"RA")) I $P(SR("RA"),"^",2)="N" D CANCHK

 S SRADFN=0 F  S SRADFN=$O(^SRF("ARS","C","I",SRADFN)) Q:'SRADFN  S SRTN=0 F  S SRTN=$O(^SRF("ARS","C","I",SRADFN,SRTN)) Q:'SRTN  S SR("RA")=$G(^SRF(SRTN,"RA")) D CANCHK

 S SRADFN=0 F  S SRADFN=$O(^SRF("ARS","N","C",SRADFN)) Q:'SRADFN  S SRTN=0 F  S SRTN=$O(^SRF("ARS","N","C",SRADFN,SRTN)) Q:'SRTN  S SR("RA")=$G(^SRF(SRTN,"RA")) D STUFF

 S SRATOTM=SRAMNUM D ^SROATM4

 D ^SROATCM

 D ^SROATMNO

 D WL

 I $D(ZTQUEUED) S ZTREQ="@"

 Q

STUFF ; stuff entries into ^TMP("SRA"

 ; check ARS cross-reference

 I $P(^SRF(SRTN,"RA"),"^",2)="C" K ^SRF("ARS","N","C",SRADFN,SRTN) K DR S DIE=130,DR="235///C",DA=SRTN D ^DIE K DR Q

 I $P(SR("RA"),"^",2)'="N" Q

 D CANCHK I 'OK Q

 I $P(SR("RA"),"^",6)="N" S ^SRF("ARS","N","C",SRADFN,SRTN)=1 Q

 I SRACNT+15>100 S SRACNT=1,SRAMNUM=SRAMNUM+1

 S SRATOT=SRATOT+1,X=$E($P(^SRF(SRTN,0),"^",9),1,5)_"00",^TMP("SRWL",$J,X)=""

 K SRA,VADM D ^SROATM1 K SHEMP,VADM,SRA

 Q

CANCHK ; check to see if case has been cancelled

 S OK=1,X=$P($G(^SRF(SRTN,30)),"^") I X S OK=0

 S X=$P($G(^SRF(SRTN,31)),"^",8) I X'="" S OK=0

 I 'OK K DA,DIE,DR S DA=SRTN,DIE=130,DR="102///@;235///@;284///@;323///@" D ^DIE K DR,DA,DIE

 Q

WL ; send workload updates

 N SRSEL S SRP=0,SRT=1,X=$$SITE^SROVAR,SRINST=$P(X,"^",2),SRSTATN=+$P(X,"^",3),SRDT=0,SRNOACK=1 D DTCHK

 F  S SRDT=$O(^TMP("SRWL",$J,SRDT)) Q:'SRDT  I SRDT>SRLO S SRSEL=1 D ^SROAWL1

 K ^TMP("SRWL",$J),SRLO

 Q

DTCHK N X,Y

 S X=$E(DT,1,3),Y=+$E(DT,4,7),SRLO=$S(Y<1000:X-2,1:X-1)_"0900"

 Q

SROATMIT  ;BIR/MAM - STUFF TRANMISSION IN ^TMP ;03/22/06

 +1       ;;3.0; Surgery ;**18,27,38,55,62,68,153**;24 Jun 93;Build 11

 +2       ;** NOTICE: This routine is part of an implementation of a nationally

 +3       ;**         controlled procedure. Local modifications to this routine

 +4       ;**         are prohibited.

 +5       ;

 +6        KILL ^TMP("SRA",$JOB),^TMP("SRAMSG",$JOB),^TMP("SRWL",$JOB)

           SET SRATOT=0

           SET SRASITE=+$PIECE($$SITE^SROVAR,"^",3)

           SET (SRAMNUM,SRACNT)=1

 +7        SET SRADFN=0

           FOR 

               SET SRADFN=$ORDER(^SRF("ARS","N","I",SRADFN))

               IF 'SRADFN

                   QUIT 

               SET SRTN=0

               FOR 

                   SET SRTN=$ORDER(^SRF("ARS","N","I",SRADFN,SRTN))

                   IF 'SRTN

                       QUIT 

                   SET SR("RA")=$GET(^SRF(SRTN,"RA"))

                   IF $PIECE(SR("RA"),"^",2)="N"

                       DO CANCHK

 +8        SET SRADFN=0

           FOR 

               SET SRADFN=$ORDER(^SRF("ARS","C","I",SRADFN))

               IF 'SRADFN

                   QUIT 

               SET SRTN=0

               FOR 

                   SET SRTN=$ORDER(^SRF("ARS","C","I",SRADFN,SRTN))

                   IF 'SRTN

                       QUIT 

                   SET SR("RA")=$GET(^SRF(SRTN,"RA"))

                   DO CANCHK

 +9        SET SRADFN=0

           FOR 

               SET SRADFN=$ORDER(^SRF("ARS","N","C",SRADFN))

               IF 'SRADFN

                   QUIT 

               SET SRTN=0

               FOR 

                   SET SRTN=$ORDER(^SRF("ARS","N","C",SRADFN,SRTN))

                   IF 'SRTN

                       QUIT 

                   SET SR("RA")=$GET(^SRF(SRTN,"RA"))

                   DO STUFF

 +10       SET SRATOTM=SRAMNUM

           DO ^SROATM4

 +11       DO ^SROATCM

 +12       DO ^SROATMNO

 +13       DO WL

 +14       IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +15       QUIT 

STUFF     ; stuff entries into ^TMP("SRA"

 +1       ; check ARS cross-reference

 +2        IF $PIECE(^SRF(SRTN,"RA"),"^",2)="C"

               KILL ^SRF("ARS","N","C",SRADFN,SRTN)

               KILL DR

               SET DIE=130

               SET DR="235///C"

               SET DA=SRTN

               DO ^DIE

               KILL DR

               QUIT 

 +3        IF $PIECE(SR("RA"),"^",2)'="N"

               QUIT 

 +4        DO CANCHK

           IF 'OK

               QUIT 

 +5        IF $PIECE(SR("RA"),"^",6)="N"

               SET ^SRF("ARS","N","C",SRADFN,SRTN)=1

               QUIT 

 +6        IF SRACNT+15>100

               SET SRACNT=1

               SET SRAMNUM=SRAMNUM+1

 +7        SET SRATOT=SRATOT+1

           SET X=$EXTRACT($PIECE(^SRF(SRTN,0),"^",9),1,5)_"00"

           SET ^TMP("SRWL",$JOB,X)=""

 +8        KILL SRA,VADM

           DO ^SROATM1

           KILL SHEMP,VADM,SRA

 +9        QUIT 

CANCHK    ; check to see if case has been cancelled

 +1        SET OK=1

           SET X=$PIECE($GET(^SRF(SRTN,30)),"^")

           IF X

               SET OK=0

 +2        SET X=$PIECE($GET(^SRF(SRTN,31)),"^",8)

           IF X'=""

               SET OK=0

 +3        IF 'OK

               KILL DA,DIE,DR

               SET DA=SRTN

               SET DIE=130

               SET DR="102///@;235///@;284///@;323///@"

               DO ^DIE

               KILL DR,DA,DIE

 +4        QUIT 

WL        ; send workload updates

 +1        NEW SRSEL

           SET SRP=0

           SET SRT=1

           SET X=$$SITE^SROVAR

           SET SRINST=$PIECE(X,"^",2)

           SET SRSTATN=+$PIECE(X,"^",3)

           SET SRDT=0

           SET SRNOACK=1

           DO DTCHK

 +2        FOR 

               SET SRDT=$ORDER(^TMP("SRWL",$JOB,SRDT))

               IF 'SRDT

                   QUIT 

               IF SRDT>SRLO

                   SET SRSEL=1

                   DO ^SROAWL1

 +3        KILL ^TMP("SRWL",$JOB),SRLO

 +4        QUIT 

DTCHK      NEW X,Y

 +1        SET X=$EXTRACT(DT,1,3)

           SET Y=+$EXTRACT(DT,4,7)

           SET SRLO=$SELECT(Y<1000:X-2,1:X-1)_"0900"

 +2        QUIT