- SR54UTL ;BIR/SLM-Transmit missing surgery risk data ; [ 05/24/96 8:00 AM ]
- ;;3.0; Surgery ;**54**;24 Jun 93
- ;;site-id^divison^ien^airway index^airway trauma^major/minor^in/out patient status^race^death unrelated/related^occurrence date^occurrence date^occ...
- EN1 S SITE=+$P($$SITE^SROVAR,"^",3)
- S (SRDFN,SRI)=0 F S SRDFN=$O(^SRF("ARS","N","T",SRDFN)) Q:'SRDFN S SRTN=0 F S SRTN=$O(^SRF("ARS","N","T",SRDFN,SRTN)) Q:'SRTN I $P(^SRF(SRTN,"RA"),"^",6)="Y" S SROPD=$E($P(^SRF(SRTN,0),"^",9),1,7) I SROPD'<"2950901" D
- .S (SRDIV,SRAI,SRAT,SRACE,SRDEATH)=""
- .S SRDIV=$P($G(^SRF(SRTN,8)),U),SRAI=$P($G(^SRF(SRTN,.3)),"^",9),SRMJN=$P(^SRF(SRTN,0),"^",3),SRMJN=$S(SRMJN="J":"J",SRMJN="N":"N",1:"")
- .S SRSTATUS=$P(^SRF(SRTN,0),"^",12),SRSTATUS=$S(SRSTATUS="I":"I",SRSTATUS="O":"O",1:""),SRACE=$P(^SRF(SRTN,208),"^",10),SRDEATH=$P($G(^SRF(SRTN,.4)),"^",7)
- .K SRTECH,SRZ S SRT=0 F S SRT=$O(^SRF(SRTN,6,SRT)) Q:'SRT D ^SROPRIN Q:$D(SRZ)
- .I $D(SRTECH) S SRAT=$P(^SRF(SRTN,6,SRT,0),"^",14)
- .I '$D(SRTECH) S SRAT=""
- .S SRSDATE=SROPD D OCC^SROAUTL0 F I=1:1:26 S SROC(I)=$TR(SROC(I)," ","")
- .S SRLINE(1)=SITE_"^"_SRDIV_"^"_SRTN_"^"_SRAI_"^"_SRAT_"^"_SRMJN_"^"_SRSTATUS_"^"_SRACE_"^"_SRDEATH_"^"_SROC(1)_"^"_SROC(2)_"^"_SROC(25)_"^"_SROC(4)_"^"_SROC(6)_"^"_SROC(7)_"^"_SROC(5)_"^"_SROC(9)_"^"_SROC(10)_"^"_SROC(11)_"^"
- .S SRLINE(1)=SRLINE(1)_SROC(19)_"^"_SROC(13)_"^"_SROC(14)_"^"_SROC(15)_"^"_SROC(22)_"^"_SROC(17)_"^"_SROC(18)_"^"_SROC(21)_"^"_SROC(23)_"^"_SROC(24)_"^"_SROC(26)_"^"_SROC(3)_"^"_SROC(8)_"^"_SROC(16)_"^"_SROC(12)_"^"_SROC(20)
- .S SRI=SRI+1,^TMP("SRA",$J,SRI)=SRLINE(1)
- ACK ;
- S XMSUB="SURGERY RISK ASSESSMENT RETRANSMISSION COMPLETE FOR VAMC-"_SITE,XMDUZ=^XMB("NETNAME")
- S XMY("G.SURGERY DEVELOPMENT TEAM@ISC-BIRM.DOMAIN.EXT")=""
- S XMTEXT="^TMP(""SRA"",$J," N I D ^XMD
- K SRDIV,SRAI,SRAT,SRACE,^TMP("SRA"),SRTN,SITE
- S ZTREQ="@"
- Q
- POST ; postinit action for SR*3*54
- S ^DD(130,0,"ID",26)="W:$D(^(""OP"")) "" "",$P(^(""OP""),U,1)"
- S ZTRTN="EN1^SR54UTL",ZTDESC="Surgery Risk Assessment Retransmission Routine",ZTIO="" S:$G(XPDQUES("POS1")) ZTDTH=XPDQUES("POS1")
- D ^%ZTLOAD
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSR54UTL 2125 printed Feb 19, 2025@00:05:16 Page 2
- SR54UTL ;BIR/SLM-Transmit missing surgery risk data ; [ 05/24/96 8:00 AM ]
- +1 ;;3.0; Surgery ;**54**;24 Jun 93
- +2 ;;site-id^divison^ien^airway index^airway trauma^major/minor^in/out patient status^race^death unrelated/related^occurrence date^occurrence date^occ...
- EN1 SET SITE=+$PIECE($$SITE^SROVAR,"^",3)
- +1 SET (SRDFN,SRI)=0
- FOR
- SET SRDFN=$ORDER(^SRF("ARS","N","T",SRDFN))
- if 'SRDFN
- QUIT
- SET SRTN=0
- FOR
- SET SRTN=$ORDER(^SRF("ARS","N","T",SRDFN,SRTN))
- if 'SRTN
- QUIT
- IF $PIECE(^SRF(SRTN,"RA"),"^",6)="Y"
- SET SROPD=$EXTRACT($PIECE(^SRF(SRTN,0),"^",9),1,7)
- IF SROPD'<"2950901"
- Begin DoDot:1
- +2 SET (SRDIV,SRAI,SRAT,SRACE,SRDEATH)=""
- +3 SET SRDIV=$PIECE($GET(^SRF(SRTN,8)),U)
- SET SRAI=$PIECE($GET(^SRF(SRTN,.3)),"^",9)
- SET SRMJN=$PIECE(^SRF(SRTN,0),"^",3)
- SET SRMJN=$SELECT(SRMJN="J":"J",SRMJN="N":"N",1:"")
- +4 SET SRSTATUS=$PIECE(^SRF(SRTN,0),"^",12)
- SET SRSTATUS=$SELECT(SRSTATUS="I":"I",SRSTATUS="O":"O",1:"")
- SET SRACE=$PIECE(^SRF(SRTN,208),"^",10)
- SET SRDEATH=$PIECE($GET(^SRF(SRTN,.4)),"^",7)
- +5 KILL SRTECH,SRZ
- SET SRT=0
- FOR
- SET SRT=$ORDER(^SRF(SRTN,6,SRT))
- if 'SRT
- QUIT
- DO ^SROPRIN
- if $DATA(SRZ)
- QUIT
- +6 IF $DATA(SRTECH)
- SET SRAT=$PIECE(^SRF(SRTN,6,SRT,0),"^",14)
- +7 IF '$DATA(SRTECH)
- SET SRAT=""
- +8 SET SRSDATE=SROPD
- DO OCC^SROAUTL0
- FOR I=1:1:26
- SET SROC(I)=$TRANSLATE(SROC(I)," ","")
- +9 SET SRLINE(1)=SITE_"^"_SRDIV_"^"_SRTN_"^"_SRAI_"^"_SRAT_"^"_SRMJN_"^"_SRSTATUS_"^"_SRACE_"^"_SRDEATH_"^"_SROC(1)_"^"_SROC(2)_"^"_SROC(25)_"^"_SROC(4)_"^"_SROC(6)_"^"_SROC(7)_"^"_SROC(5)_"^"_SROC(9)_"^"_SROC(10)_"^"_SROC(11)_
- "^"
- +10 SET SRLINE(1)=SRLINE(1)_SROC(19)_"^"_SROC(13)_"^"_SROC(14)_"^"_SROC(15)_"^"_SROC(22)_"^"_SROC(17)_"^"_SROC(18)_"^"_SROC(21)_"^"_SROC(23)_"^"_SROC(24)_"^"_SROC(26)_"^"_SROC(3)_"^"_SROC(8)_"^"_SROC(16)_"^"_SROC(12)_"^"_SROC(20
- )
- +11 SET SRI=SRI+1
- SET ^TMP("SRA",$JOB,SRI)=SRLINE(1)
- End DoDot:1
- ACK ;
- +1 SET XMSUB="SURGERY RISK ASSESSMENT RETRANSMISSION COMPLETE FOR VAMC-"_SITE
- SET XMDUZ=^XMB("NETNAME")
- +2 SET XMY("G.SURGERY DEVELOPMENT TEAM@ISC-BIRM.DOMAIN.EXT")=""
- +3 SET XMTEXT="^TMP(""SRA"",$J,"
- NEW I
- DO ^XMD
- +4 KILL SRDIV,SRAI,SRAT,SRACE,^TMP("SRA"),SRTN,SITE
- +5 SET ZTREQ="@"
- +6 QUIT
- POST ; postinit action for SR*3*54
- +1 SET ^DD(130,0,"ID",26)="W:$D(^(""OP"")) "" "",$P(^(""OP""),U,1)"
- +2 SET ZTRTN="EN1^SR54UTL"
- SET ZTDESC="Surgery Risk Assessment Retransmission Routine"
- SET ZTIO=""
- if $GET(XPDQUES("POS1"))
- SET ZTDTH=XPDQUES("POS1")
- +3 DO ^%ZTLOAD
- +4 QUIT
