SR61UTL ;BIR/SLM-Transmit missing surgery risk data
;;3.0; Surgery ;**61**;24 Jun 93
;;ICD9 code@occurrence date^ICD9 code@occurrence date^ICD9 code@occu...
EN1 S SITE=+$P($$SITE^SROVAR,"^",3)
S X=0 F S X=$O(^XPD(9.7,"B","SR*3.0*57",X)) Q:'X S SRDA=X
S Z=$G(^XPD(9.7,SRDA,1)),SRZZ=$E($P(Z,"^",3),1,7)
S SRZZ=$S(SRZZ="":"2960911",1:SRZZ)
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 SRTDT=$E($P(^SRF(SRTN,"RA"),"^",4),1,7) I SRTDT'<SRZZ D
.S SRSDATE=$E($P(^SRF(SRTN,0),"^",9),1,7)
.D OCC^SROAUTL0 F I=1:1:26 S SROC(I)=$TR(SROC(I)," ","")
.S SRZ=0 F SRZ=21,29:1:32 I $P($G(SROOC(SRZ)),U)="NO ICD9 CODE ENTERED" S $P(SROOC(SRZ),U)="NS"
.S SRRES=$P($G(SROOC(29)),U)_"@"_SROC(8) I SRRES="@" S SRRES=""
.S SRCNS=$P($G(SROOC(30)),U)_"@"_SROC(16) I SRCNS="@" S SRCNS=""
.S SRUTR=$P($G(SROOC(31)),U)_"@"_SROC(12) I SRUTR="@" S SRUTR=""
.S SRCAR=$P($G(SROOC(32)),U)_"@"_SROC(20) I SRCAR="@" S SRCAR=""
.S SROTH=$P($G(SROOC(21)),U)_"@"_SROC(26) I SROTH="@" S SROTH=""
.S SRDIV=$P($G(^SRF(SRTN,8)),"^")
.S SRI=SRI+1,^TMP("SRA",$J,SRI)=SITE_"^"_SRDIV_"^"_SRTN_"^"_SRRES_"^"_SRCNS_"^"_SRUTR_"^"_SRCAR_"^"_SROTH
ACK ;
S XMSUB="*** SR*3*61 FROM VAMC-"_SITE_" ***",XMDUZ=^XMB("NETNAME")
S XMY("G.SRCOSERV@ISC-CHICAGO.DOMAIN.EXT")=""
S XMTEXT="^TMP(""SRA"",$J," N I D ^XMD
K ^TMP("SRA"),SRTN,SITE,SRCAR,SRCNS,SRDA,SRDFN,SRI,SROC,SROOC,SROTH,SRRES,SRSDATE,SRTDT,SRUTR,SRZ,SRZZ,SRDIV
S ZTREQ="@"
Q
POST ; postinit action for SR*3*61
S ^DD(130,0,"ID",26)="W:$D(^(""OP"")) "" "",$P(^(""OP""),U,1)"
S ZTRTN="EN1^SR61UTL",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[HSR61UTL 1798 printed Dec 13, 2024@02:38:47 Page 2
SR61UTL ;BIR/SLM-Transmit missing surgery risk data
+1 ;;3.0; Surgery ;**61**;24 Jun 93
+2 ;;ICD9 code@occurrence date^ICD9 code@occurrence date^ICD9 code@occu...
EN1 SET SITE=+$PIECE($$SITE^SROVAR,"^",3)
+1 SET X=0
FOR
SET X=$ORDER(^XPD(9.7,"B","SR*3.0*57",X))
if 'X
QUIT
SET SRDA=X
+2 SET Z=$GET(^XPD(9.7,SRDA,1))
SET SRZZ=$EXTRACT($PIECE(Z,"^",3),1,7)
+3 SET SRZZ=$SELECT(SRZZ="":"2960911",1:SRZZ)
+4 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 SRTDT=$EXTRACT($PIECE(^SRF(SRTN,"RA"),"^",4),1,7)
IF SRTDT'<SRZZ
Begin DoDot:1
+5 SET SRSDATE=$EXTRACT($PIECE(^SRF(SRTN,0),"^",9),1,7)
+6 DO OCC^SROAUTL0
FOR I=1:1:26
SET SROC(I)=$TRANSLATE(SROC(I)," ","")
+7 SET SRZ=0
FOR SRZ=21,29:1:32
IF $PIECE($GET(SROOC(SRZ)),U)="NO ICD9 CODE ENTERED"
SET $PIECE(SROOC(SRZ),U)="NS"
+8 SET SRRES=$PIECE($GET(SROOC(29)),U)_"@"_SROC(8)
IF SRRES="@"
SET SRRES=""
+9 SET SRCNS=$PIECE($GET(SROOC(30)),U)_"@"_SROC(16)
IF SRCNS="@"
SET SRCNS=""
+10 SET SRUTR=$PIECE($GET(SROOC(31)),U)_"@"_SROC(12)
IF SRUTR="@"
SET SRUTR=""
+11 SET SRCAR=$PIECE($GET(SROOC(32)),U)_"@"_SROC(20)
IF SRCAR="@"
SET SRCAR=""
+12 SET SROTH=$PIECE($GET(SROOC(21)),U)_"@"_SROC(26)
IF SROTH="@"
SET SROTH=""
+13 SET SRDIV=$PIECE($GET(^SRF(SRTN,8)),"^")
+14 SET SRI=SRI+1
SET ^TMP("SRA",$JOB,SRI)=SITE_"^"_SRDIV_"^"_SRTN_"^"_SRRES_"^"_SRCNS_"^"_SRUTR_"^"_SRCAR_"^"_SROTH
End DoDot:1
ACK ;
+1 SET XMSUB="*** SR*3*61 FROM VAMC-"_SITE_" ***"
SET XMDUZ=^XMB("NETNAME")
+2 SET XMY("G.SRCOSERV@ISC-CHICAGO.DOMAIN.EXT")=""
+3 SET XMTEXT="^TMP(""SRA"",$J,"
NEW I
DO ^XMD
+4 KILL ^TMP("SRA"),SRTN,SITE,SRCAR,SRCNS,SRDA,SRDFN,SRI,SROC,SROOC,SROTH,SRRES,SRSDATE,SRTDT,SRUTR,SRZ,SRZZ,SRDIV
+5 SET ZTREQ="@"
+6 QUIT
POST ; postinit action for SR*3*61
+1 SET ^DD(130,0,"ID",26)="W:$D(^(""OP"")) "" "",$P(^(""OP""),U,1)"
+2 SET ZTRTN="EN1^SR61UTL"
SET ZTDESC="Surgery Risk Assessment Retransmission Routine"
SET ZTIO=""
if $GET(XPDQUES("POS1"))
SET ZTDTH=XPDQUES("POS1")
+3 DO ^%ZTLOAD
+4 QUIT
