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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROATMIT 2088 printed Dec 13, 2024@02:42:12 Page 2
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
