- 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
