SR61UTL.m

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 ---SR61UTL   1798     printed  Apr 09, 2024@21:48:27                                                                                                                                                                                                     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