- SROAWL1 ;BIR/ADM - REPORT OF CASE WORKLOAD TOTALS (CONTINUED) ;02/12/07
- ;;3.0;Surgery;**38,47,60,62,68,50,86,88,92,153,160,184,200**;24 Jun 93;Build 9
- ; SRTOTAL(1) = total of all cases completed (excluding aborted cases)
- ; SRTOTAL(2) = excluded cases
- ; SRTOTAL(3) = assessed cases
- ; SRTOTAL(4) = not logged major cases
- ; SRTOTAL(5) = cardiac cases
- ; SRTOTAL(6) = non-cardiac cases
- ; SRTOTAL(7) = assessed cases per day (at 20 days per month)
- ; SRTOTAL(8) = total major cases
- ; SRTOTAL(9) = total minor cases
- ; SRTOTAL(10)= total eligible case based on CPT code
- ; SRTOTAL(11)= not logged eligible cases
- ; SRTOTAL(12)= Robotic cases
- ;
- I SRP U IO
- N SRDIV,SRMULT S (SRDIV,SRMULT,SRSOUT)=0
- I SRT S (SRCNT,X)=0 D
- .F S X=$O(^SRO(133,X)) Q:'X I '$P($G(^SRO(133,X,0)),"^",21) S SRCNT=SRCNT+1,SRDIV(X)=$P(^SRO(133,X,0),"^")
- .I SRCNT>1 S SRMULT=1
- BEG S SRSDATE=SRDT I SRSEL=1 S X=+$E(SRDT,4,5),X=$S(X'=12:X+1,1:1),Y=$E(SRDT,1,3),Y=$S(X>1:Y,1:Y+1),SRED=Y_$S($L(X)=1:"0"_X,1:X)_"00"
- I SRSEL=2 S X=$E(SREDT,1,5),SRED=X_"99"
- K SRTOTAL F I=1:1:12 S SRTOTAL(I)=0
- N SREXCL F I=0:1:9 S SREXCL(I)=0
- S SREXCL("A")=0
- S:'$D(SRINSTP) SRINSTP="ALL DIVISIONS"
- I SRSEL=1 D MOS S Y=SRDT X ^DD("DD") S SRM="FOR "_Y,SRTITLE="REPORT OF MONTHLY SURGICAL CASE WORKLOAD"
- I SRSEL=2 S SRTITLE="REPORT OF SURGICAL CASE WORKLOAD" D
- .S Y=SRDT X ^DD("DD") S SRM="FOR "_Y_" THROUGH " S Y=SREDT X ^DD("DD") S SRM=SRM_Y
- F S SRSDATE=$O(^SRF("AC",SRSDATE)) Q:SRSDATE>SRED!'SRSDATE S SRTN=0 F S SRTN=$O(^SRF("AC",SRSDATE,SRTN)) Q:'SRTN I $D(^SRF(SRTN,0)),$$MANDIV^SROUTL0(SRINSTP,SRTN) D CASE
- F K="C","N" S SRDFN=0 F S SRDFN=$O(^SRF("ARS",K,"I",SRDFN)) Q:'SRDFN S SRTN=0 F S SRTN=$O(^SRF("ARS",K,"I",SRDFN,SRTN)) Q:'SRTN I $D(^SRF(SRTN,0)),$$MANDIV^SROUTL0(SRINSTP,SRTN) D OPDATE
- I SRSEL=1 S SRTOTAL(7)=SRTOTAL(3)/20 D:'SRP INC D:SRP OUT G:SRSOUT END D:SRT TMIT
- I SRSEL=2 D OUT
- END K SRINSTP,SRTOTAL,^TMP("SRM",$J) I SRT,SRMULT S SRP=0 S SRDIV=$O(SRDIV(SRDIV)) Q:'SRDIV D SITE,BEG
- Q
- CASE ; examine case
- Q:$P($G(^SRF(SRTN,30)),"^")!$P($G(^SRF(SRTN,31)),"^",8)!'($P($G(^SRF(SRTN,.2)),"^",12)!($P($G(^SRF(SRTN,.2)),"^",3)))
- N SRELIG S SRELIG=""
- S SRTOTAL(1)=SRTOTAL(1)+1,SRMAJ=$S($P(^SRF(SRTN,0),"^",3)="J":1,1:0) S:SRMAJ SRTOTAL(8)=SRTOTAL(8)+1 I 'SRMAJ S SRTOTAL(9)=SRTOTAL(9)+1
- I $$XL^SROAX(SRTN) S SRELIG=1,SRTOTAL(10)=SRTOTAL(10)+1
- S SRA=$G(^SRF(SRTN,"RA")),SRTYPE=$P(SRA,"^",2) S:SRTYPE=""&SRMAJ SRTOTAL(4)=SRTOTAL(4)+1 S:SRTYPE="C" SRTOTAL(5)=SRTOTAL(5)+1
- I SRTYPE=""&SRELIG S SRTOTAL(11)=SRTOTAL(11)+1
- S SRASS=$P(SRA,"^",6) D
- .I SRASS="N" S SRTOTAL(2)=SRTOTAL(2)+1,X=$P(SRA,"^",7) S:X'="" SREXCL(X)=SREXCL(X)+1
- .I SRASS="Y" S SRTOTAL(3)=SRTOTAL(3)+1
- I SRTYPE="N",SRASS="Y" S SRTOTAL(6)=SRTOTAL(6)+1
- I $$GET1^DIQ(130,SRTN_",",2006,"I")="Y" S SRTOTAL(12)=SRTOTAL(12)+1
- Q
- OPDATE ; get date of operation
- S SRA=$G(^SRF(SRTN,"RA")) I $P(SRA,"^")'="I" K ^SRF("ARS",K,"I",SRDFN,SRTN) Q
- S SRTYPE=$P(SRA,"^",2) I SRTYPE'=K K ^SRF("ARS",K,"I",SRDFN,SRTN) Q
- I SRSEL=1 S SRMONTH=$E($P(^SRF(SRTN,0),"^",9),1,5)_"00" I $D(^TMP("SRM",$J,SRMONTH,K)) S ^TMP("SRM",$J,SRMONTH,K)=^TMP("SRM",$J,SRMONTH,K)+1
- Q
- OUT ; print report
- W:$Y @IOF W !,?(80-$L(SRINST)\2),SRINST,!,?(80-$L(SRTITLE)\2),SRTITLE,!,?(80-$L(SRM)\2),SRM,!,?15 F I=1:1:50 W "-"
- W !,?20,"TOTAL CASES PERFORMED",?54,"=",$J(SRTOTAL(1),6),!,?24,"TOTAL ELIGIBLE CASES",?54,"=",$J(SRTOTAL(10),6)
- ;W !,?24,"TOTAL MAJOR CASES",?54,"=",$J(SRTOTAL(8),6),!,?24,"TOTAL MINOR CASES",?54,"=",$J(SRTOTAL(9),6)
- W !,?20,"CASES MEETING EXCLUSION CRITERIA",?54,"=",$J(SRTOTAL(2),6)
- W !,?24,"NON-SURGEON CASE",?54,"=",$J(SREXCL(0),6)
- W !,?24,"EXCEEDS MAX. ASSESSMENTS",?54,"=",$J(SREXCL(2),6),!,?24,"EXCEEDS MAXIMUM TURPS",?54,"=",$J(SREXCL(3),6)
- W !,?24,"INCLUSION CRTA NOT MET",?54,"=",$J(SREXCL(4),6),!,?24,"10% RULE",?54,"=",$J(SREXCL(6),6)
- W !,?24,"CONCURRENT CASE",?54,"=",$J(SREXCL(8),6),!,?24,"EXCEEDS MAXIMUM HERNIAS",?54,"=",$J(SREXCL(9),6)
- W !,?24,"ABORTED",?54,"=",$J(SREXCL("A"),6)
- W !,?20,"ASSESSED CASES",?54,"=",$J(SRTOTAL(3),6)
- ;W !,?20,"NOT LOGGED MAJOR CASES",?54,"=",$J(SRTOTAL(4),6)
- W !,?20,"NOT LOGGED ELIGIBLE CASES",?54,"=",$J(SRTOTAL(11),6)
- W !,?20,"CARDIAC CASES",?54,"=",$J(SRTOTAL(5),6),!,?20,"NON-CARDIAC CASES",?54,"=",$J(SRTOTAL(6),6)
- W !,?20,"CASES WITH ROBOTIC ASSISTANCE",?54,"=",$J(SRTOTAL(12),6)
- W:SRSEL=1 !,?20,"ASSESSED CASES PER DAY",?54,"=",$J(SRTOTAL(7),9,2) W !,?15 F I=1:1:50 W "-"
- Q:SRSEL=2 I $E(IOST)="C" D PRESS Q:SRSOUT W @IOF
- INC S (SRCT,SRT1,SRTC)=0 W:SRP !!!!,?12,"NUMBER OF INCOMPLETE ASSESSMENTS REMAINING FOR PAST YEAR",!!,?29,"CARDIAC",?40,"NON-CARDIAC",?56,"TOTAL",!,?29,"-------",?40,"-----------",?56,"-----"
- S SRMONTH=0,SRSST="" F S SRMONTH=$O(^TMP("SRM",$J,SRMONTH)) Q:'SRMONTH D
- .I SRP S Y=SRMONTH X ^DD("DD") W !,?19,Y
- .S SRC=^TMP("SRM",$J,SRMONTH,"C"),SRN=^TMP("SRM",$J,SRMONTH,"N"),SRTO=SRC+SRN,SRCT=SRCT+SRC,SRT1=SRT1+SRN,SRTC=SRTC+SRTO,SRSST=SRSST_SRMONTH_"^"_SRC_"^"_SRN_"^"
- .W:SRP ?30,$J(SRC,5),?43,$J(SRN,5),?55,$J(SRTO,5)
- W:SRP !,?29,"-------",?40,"-----------",?56,"-----",!,?30,$J(SRCT,5),?43,$J(SRT1,5),?55,$J(SRTC,5)
- Q
- TMIT ; transmit report to national database
- S ISC=1 I $$PROD^XUPROD() S ISC=0
- S NAME=$G(^XMB("NETNAME")) I NAME["FORUM" S ISC=1
- K SRMSG S SRSTATN=$P($$SITE^SROVAR,"^",3)_$S(SRDIV:"-"_SRDIV,1:""),SRMSG(1)=SRSTATN_"^"_SRDT_"^"_DT F I=1:1:9 S SRMSG(1)=SRMSG(1)_"^"_SRTOTAL(I)
- F I=1,2,3,4,6,8,9,0 S SRMSG(1)=SRMSG(1)_"^"_SREXCL(I)
- I SRDIV S SRMSG(1)=SRMSG(1)_"^"_SRINST_"^"_$$GET1^DIQ(4,SRINSTP,99)
- S $P(SRMSG(1),"^",23)=SREXCL("A")
- S SRMSG(2)=SRSTATN_"^"_SRSST_SREXCL(0)
- S SRMSG(3)=SRSTATN_"^"_$S($D(SRNOACK):SRNOACK,1:0)_"^"_SRTOTAL(10)_"^"_SRTOTAL(11)_"^"_SRTOTAL(12)
- S XMDUZ=.5,XMSUB="SURGERY WORKLOAD "_SRM
- I ISC S XMY("G.RISK ASSESSMENT")=""
- I 'ISC S (XMY("S.SRAWSERV@FO-HINES.DOMAIN.EXT"),XMY("G.SRCOSERV@FO-HINES.DOMAIN.EXT"))=""
- S XMTEXT="SRMSG(" D ^XMD K XMSUB,XMY,XMDUZ,XMTEXT
- Q
- MOS ; set up array for past 12 months
- K SRMONTH S SRYR=$E(SRDT,1,3),SRMONTH=+$E(SRDT,4,5)
- S J=1 F S:$L(SRMONTH)=1 SRMONTH="0"_SRMONTH S SRMONTH(J)=SRYR_SRMONTH_"00" S SRMONTH=+SRMONTH,SRMONTH=$S(SRMONTH=1:12,1:SRMONTH-1),SRYR=$S(SRMONTH=12:SRYR-1,1:SRYR),J=J+1 Q:J>13
- K ^TMP("SRM",$J) F I=1:1:13 F J="C","N" S ^TMP("SRM",$J,SRMONTH(I),J)=0
- Q
- PRESS Q:$E(IOST)'="C" K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S SRSOUT=1
- Q
- SITE S SRINSTP=SRDIV(SRDIV),SRINST=$$GET1^DIQ(4,SRINSTP,.01)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROAWL1 6445 printed Jan 18, 2025@03:43:37 Page 2
- SROAWL1 ;BIR/ADM - REPORT OF CASE WORKLOAD TOTALS (CONTINUED) ;02/12/07
- +1 ;;3.0;Surgery;**38,47,60,62,68,50,86,88,92,153,160,184,200**;24 Jun 93;Build 9
- +2 ; SRTOTAL(1) = total of all cases completed (excluding aborted cases)
- +3 ; SRTOTAL(2) = excluded cases
- +4 ; SRTOTAL(3) = assessed cases
- +5 ; SRTOTAL(4) = not logged major cases
- +6 ; SRTOTAL(5) = cardiac cases
- +7 ; SRTOTAL(6) = non-cardiac cases
- +8 ; SRTOTAL(7) = assessed cases per day (at 20 days per month)
- +9 ; SRTOTAL(8) = total major cases
- +10 ; SRTOTAL(9) = total minor cases
- +11 ; SRTOTAL(10)= total eligible case based on CPT code
- +12 ; SRTOTAL(11)= not logged eligible cases
- +13 ; SRTOTAL(12)= Robotic cases
- +14 ;
- +15 IF SRP
- USE IO
- +16 NEW SRDIV,SRMULT
- SET (SRDIV,SRMULT,SRSOUT)=0
- +17 IF SRT
- SET (SRCNT,X)=0
- Begin DoDot:1
- +18 FOR
- SET X=$ORDER(^SRO(133,X))
- if 'X
- QUIT
- IF '$PIECE($GET(^SRO(133,X,0)),"^",21)
- SET SRCNT=SRCNT+1
- SET SRDIV(X)=$PIECE(^SRO(133,X,0),"^")
- +19 IF SRCNT>1
- SET SRMULT=1
- End DoDot:1
- BEG SET SRSDATE=SRDT
- IF SRSEL=1
- SET X=+$EXTRACT(SRDT,4,5)
- SET X=$SELECT(X'=12:X+1,1:1)
- SET Y=$EXTRACT(SRDT,1,3)
- SET Y=$SELECT(X>1:Y,1:Y+1)
- SET SRED=Y_$SELECT($LENGTH(X)=1:"0"_X,1:X)_"00"
- +1 IF SRSEL=2
- SET X=$EXTRACT(SREDT,1,5)
- SET SRED=X_"99"
- +2 KILL SRTOTAL
- FOR I=1:1:12
- SET SRTOTAL(I)=0
- +3 NEW SREXCL
- FOR I=0:1:9
- SET SREXCL(I)=0
- +4 SET SREXCL("A")=0
- +5 if '$DATA(SRINSTP)
- SET SRINSTP="ALL DIVISIONS"
- +6 IF SRSEL=1
- DO MOS
- SET Y=SRDT
- XECUTE ^DD("DD")
- SET SRM="FOR "_Y
- SET SRTITLE="REPORT OF MONTHLY SURGICAL CASE WORKLOAD"
- +7 IF SRSEL=2
- SET SRTITLE="REPORT OF SURGICAL CASE WORKLOAD"
- Begin DoDot:1
- +8 SET Y=SRDT
- XECUTE ^DD("DD")
- SET SRM="FOR "_Y_" THROUGH "
- SET Y=SREDT
- XECUTE ^DD("DD")
- SET SRM=SRM_Y
- End DoDot:1
- +9 FOR
- SET SRSDATE=$ORDER(^SRF("AC",SRSDATE))
- if SRSDATE>SRED!'SRSDATE
- QUIT
- SET SRTN=0
- FOR
- SET SRTN=$ORDER(^SRF("AC",SRSDATE,SRTN))
- if 'SRTN
- QUIT
- IF $DATA(^SRF(SRTN,0))
- IF $$MANDIV^SROUTL0(SRINSTP,SRTN)
- DO CASE
- +10 FOR K="C","N"
- SET SRDFN=0
- FOR
- SET SRDFN=$ORDER(^SRF("ARS",K,"I",SRDFN))
- if 'SRDFN
- QUIT
- SET SRTN=0
- FOR
- SET SRTN=$ORDER(^SRF("ARS",K,"I",SRDFN,SRTN))
- if 'SRTN
- QUIT
- IF $DATA(^SRF(SRTN,0))
- IF $$MANDIV^SROUTL0(SRINSTP,SRTN)
- DO OPDATE
- +11 IF SRSEL=1
- SET SRTOTAL(7)=SRTOTAL(3)/20
- if 'SRP
- DO INC
- if SRP
- DO OUT
- if SRSOUT
- GOTO END
- if SRT
- DO TMIT
- +12 IF SRSEL=2
- DO OUT
- END KILL SRINSTP,SRTOTAL,^TMP("SRM",$JOB)
- IF SRT
- IF SRMULT
- SET SRP=0
- SET SRDIV=$ORDER(SRDIV(SRDIV))
- if 'SRDIV
- QUIT
- DO SITE
- DO BEG
- +1 QUIT
- CASE ; examine case
- +1 if $PIECE($GET(^SRF(SRTN,30)),"^")!$PIECE($GET(^SRF(SRTN,31)),"^",8)!'($PIECE($GET(^SRF(SRTN,.2)),"^",12)!($PIECE($GET(^SRF(SRTN,.2)),"^",3)))
- QUIT
- +2 NEW SRELIG
- SET SRELIG=""
- +3 SET SRTOTAL(1)=SRTOTAL(1)+1
- SET SRMAJ=$SELECT($PIECE(^SRF(SRTN,0),"^",3)="J":1,1:0)
- if SRMAJ
- SET SRTOTAL(8)=SRTOTAL(8)+1
- IF 'SRMAJ
- SET SRTOTAL(9)=SRTOTAL(9)+1
- +4 IF $$XL^SROAX(SRTN)
- SET SRELIG=1
- SET SRTOTAL(10)=SRTOTAL(10)+1
- +5 SET SRA=$GET(^SRF(SRTN,"RA"))
- SET SRTYPE=$PIECE(SRA,"^",2)
- if SRTYPE=""&SRMAJ
- SET SRTOTAL(4)=SRTOTAL(4)+1
- if SRTYPE="C"
- SET SRTOTAL(5)=SRTOTAL(5)+1
- +6 IF SRTYPE=""&SRELIG
- SET SRTOTAL(11)=SRTOTAL(11)+1
- +7 SET SRASS=$PIECE(SRA,"^",6)
- Begin DoDot:1
- +8 IF SRASS="N"
- SET SRTOTAL(2)=SRTOTAL(2)+1
- SET X=$PIECE(SRA,"^",7)
- if X'=""
- SET SREXCL(X)=SREXCL(X)+1
- +9 IF SRASS="Y"
- SET SRTOTAL(3)=SRTOTAL(3)+1
- End DoDot:1
- +10 IF SRTYPE="N"
- IF SRASS="Y"
- SET SRTOTAL(6)=SRTOTAL(6)+1
- +11 IF $$GET1^DIQ(130,SRTN_",",2006,"I")="Y"
- SET SRTOTAL(12)=SRTOTAL(12)+1
- +12 QUIT
- OPDATE ; get date of operation
- +1 SET SRA=$GET(^SRF(SRTN,"RA"))
- IF $PIECE(SRA,"^")'="I"
- KILL ^SRF("ARS",K,"I",SRDFN,SRTN)
- QUIT
- +2 SET SRTYPE=$PIECE(SRA,"^",2)
- IF SRTYPE'=K
- KILL ^SRF("ARS",K,"I",SRDFN,SRTN)
- QUIT
- +3 IF SRSEL=1
- SET SRMONTH=$EXTRACT($PIECE(^SRF(SRTN,0),"^",9),1,5)_"00"
- IF $DATA(^TMP("SRM",$JOB,SRMONTH,K))
- SET ^TMP("SRM",$JOB,SRMONTH,K)=^TMP("SRM",$JOB,SRMONTH,K)+1
- +4 QUIT
- OUT ; print report
- +1 if $Y
- WRITE @IOF
- WRITE !,?(80-$LENGTH(SRINST)\2),SRINST,!,?(80-$LENGTH(SRTITLE)\2),SRTITLE,!,?(80-$LENGTH(SRM)\2),SRM,!,?15
- FOR I=1:1:50
- WRITE "-"
- +2 WRITE !,?20,"TOTAL CASES PERFORMED",?54,"=",$JUSTIFY(SRTOTAL(1),6),!,?24,"TOTAL ELIGIBLE CASES",?54,"=",$JUSTIFY(SRTOTAL(10),6)
- +3 ;W !,?24,"TOTAL MAJOR CASES",?54,"=",$J(SRTOTAL(8),6),!,?24,"TOTAL MINOR CASES",?54,"=",$J(SRTOTAL(9),6)
- +4 WRITE !,?20,"CASES MEETING EXCLUSION CRITERIA",?54,"=",$JUSTIFY(SRTOTAL(2),6)
- +5 WRITE !,?24,"NON-SURGEON CASE",?54,"=",$JUSTIFY(SREXCL(0),6)
- +6 WRITE !,?24,"EXCEEDS MAX. ASSESSMENTS",?54,"=",$JUSTIFY(SREXCL(2),6),!,?24,"EXCEEDS MAXIMUM TURPS",?54,"=",$JUSTIFY(SREXCL(3),6)
- +7 WRITE !,?24,"INCLUSION CRTA NOT MET",?54,"=",$JUSTIFY(SREXCL(4),6),!,?24,"10% RULE",?54,"=",$JUSTIFY(SREXCL(6),6)
- +8 WRITE !,?24,"CONCURRENT CASE",?54,"=",$JUSTIFY(SREXCL(8),6),!,?24,"EXCEEDS MAXIMUM HERNIAS",?54,"=",$JUSTIFY(SREXCL(9),6)
- +9 WRITE !,?24,"ABORTED",?54,"=",$JUSTIFY(SREXCL("A"),6)
- +10 WRITE !,?20,"ASSESSED CASES",?54,"=",$JUSTIFY(SRTOTAL(3),6)
- +11 ;W !,?20,"NOT LOGGED MAJOR CASES",?54,"=",$J(SRTOTAL(4),6)
- +12 WRITE !,?20,"NOT LOGGED ELIGIBLE CASES",?54,"=",$JUSTIFY(SRTOTAL(11),6)
- +13 WRITE !,?20,"CARDIAC CASES",?54,"=",$JUSTIFY(SRTOTAL(5),6),!,?20,"NON-CARDIAC CASES",?54,"=",$JUSTIFY(SRTOTAL(6),6)
- +14 WRITE !,?20,"CASES WITH ROBOTIC ASSISTANCE",?54,"=",$JUSTIFY(SRTOTAL(12),6)
- +15 if SRSEL=1
- WRITE !,?20,"ASSESSED CASES PER DAY",?54,"=",$JUSTIFY(SRTOTAL(7),9,2)
- WRITE !,?15
- FOR I=1:1:50
- WRITE "-"
- +16 if SRSEL=2
- QUIT
- IF $EXTRACT(IOST)="C"
- DO PRESS
- if SRSOUT
- QUIT
- WRITE @IOF
- INC SET (SRCT,SRT1,SRTC)=0
- if SRP
- WRITE !!!!,?12,"NUMBER OF INCOMPLETE ASSESSMENTS REMAINING FOR PAST YEAR",!!,?29,"CARDIAC",?40,"NON-CARDIAC",?56,"TOTAL",!,?29,"-------",?40,"-----------",?56,"-----"
- +1 SET SRMONTH=0
- SET SRSST=""
- FOR
- SET SRMONTH=$ORDER(^TMP("SRM",$JOB,SRMONTH))
- if 'SRMONTH
- QUIT
- Begin DoDot:1
- +2 IF SRP
- SET Y=SRMONTH
- XECUTE ^DD("DD")
- WRITE !,?19,Y
- +3 SET SRC=^TMP("SRM",$JOB,SRMONTH,"C")
- SET SRN=^TMP("SRM",$JOB,SRMONTH,"N")
- SET SRTO=SRC+SRN
- SET SRCT=SRCT+SRC
- SET SRT1=SRT1+SRN
- SET SRTC=SRTC+SRTO
- SET SRSST=SRSST_SRMONTH_"^"_SRC_"^"_SRN_"^"
- +4 if SRP
- WRITE ?30,$JUSTIFY(SRC,5),?43,$JUSTIFY(SRN,5),?55,$JUSTIFY(SRTO,5)
- End DoDot:1
- +5 if SRP
- WRITE !,?29,"-------",?40,"-----------",?56,"-----",!,?30,$JUSTIFY(SRCT,5),?43,$JUSTIFY(SRT1,5),?55,$JUSTIFY(SRTC,5)
- +6 QUIT
- TMIT ; transmit report to national database
- +1 SET ISC=1
- IF $$PROD^XUPROD()
- SET ISC=0
- +2 SET NAME=$GET(^XMB("NETNAME"))
- IF NAME["FORUM"
- SET ISC=1
- +3 KILL SRMSG
- SET SRSTATN=$PIECE($$SITE^SROVAR,"^",3)_$SELECT(SRDIV:"-"_SRDIV,1:"")
- SET SRMSG(1)=SRSTATN_"^"_SRDT_"^"_DT
- FOR I=1:1:9
- SET SRMSG(1)=SRMSG(1)_"^"_SRTOTAL(I)
- +4 FOR I=1,2,3,4,6,8,9,0
- SET SRMSG(1)=SRMSG(1)_"^"_SREXCL(I)
- +5 IF SRDIV
- SET SRMSG(1)=SRMSG(1)_"^"_SRINST_"^"_$$GET1^DIQ(4,SRINSTP,99)
- +6 SET $PIECE(SRMSG(1),"^",23)=SREXCL("A")
- +7 SET SRMSG(2)=SRSTATN_"^"_SRSST_SREXCL(0)
- +8 SET SRMSG(3)=SRSTATN_"^"_$SELECT($DATA(SRNOACK):SRNOACK,1:0)_"^"_SRTOTAL(10)_"^"_SRTOTAL(11)_"^"_SRTOTAL(12)
- +9 SET XMDUZ=.5
- SET XMSUB="SURGERY WORKLOAD "_SRM
- +10 IF ISC
- SET XMY("G.RISK ASSESSMENT")=""
- +11 IF 'ISC
- SET (XMY("S.SRAWSERV@FO-HINES.DOMAIN.EXT"),XMY("G.SRCOSERV@FO-HINES.DOMAIN.EXT"))=""
- +12 SET XMTEXT="SRMSG("
- DO ^XMD
- KILL XMSUB,XMY,XMDUZ,XMTEXT
- +13 QUIT
- MOS ; set up array for past 12 months
- +1 KILL SRMONTH
- SET SRYR=$EXTRACT(SRDT,1,3)
- SET SRMONTH=+$EXTRACT(SRDT,4,5)
- +2 SET J=1
- FOR
- if $LENGTH(SRMONTH)=1
- SET SRMONTH="0"_SRMONTH
- SET SRMONTH(J)=SRYR_SRMONTH_"00"
- SET SRMONTH=+SRMONTH
- SET SRMONTH=$SELECT(SRMONTH=1:12,1:SRMONTH-1)
- SET SRYR=$SELECT(SRMONTH=12:SRYR-1,1:SRYR)
- SET J=J+1
- if J>13
- QUIT
- +3 KILL ^TMP("SRM",$JOB)
- FOR I=1:1:13
- FOR J="C","N"
- SET ^TMP("SRM",$JOB,SRMONTH(I),J)=0
- +4 QUIT
- PRESS if $EXTRACT(IOST)'="C"
- QUIT
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET SRSOUT=1
- +1 QUIT
- SITE SET SRINSTP=SRDIV(SRDIV)
- SET SRINST=$$GET1^DIQ(4,SRINSTP,.01)
- +1 QUIT