Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SR61UTL

SR61UTL.m

Go to the documentation of this file.
  1. SR61UTL ;BIR/SLM-Transmit missing surgery risk data
  1. ;;3.0; Surgery ;**61**;24 Jun 93
  1. ;;ICD9 code@occurrence date^ICD9 code@occurrence date^ICD9 code@occu...
  1. EN1 S SITE=+$P($$SITE^SROVAR,"^",3)
  1. S X=0 F S X=$O(^XPD(9.7,"B","SR*3.0*57",X)) Q:'X S SRDA=X
  1. S Z=$G(^XPD(9.7,SRDA,1)),SRZZ=$E($P(Z,"^",3),1,7)
  1. S SRZZ=$S(SRZZ="":"2960911",1:SRZZ)
  1. 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
  1. .S SRSDATE=$E($P(^SRF(SRTN,0),"^",9),1,7)
  1. .D OCC^SROAUTL0 F I=1:1:26 S SROC(I)=$TR(SROC(I)," ","")
  1. .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"
  1. .S SRRES=$P($G(SROOC(29)),U)_"@"_SROC(8) I SRRES="@" S SRRES=""
  1. .S SRCNS=$P($G(SROOC(30)),U)_"@"_SROC(16) I SRCNS="@" S SRCNS=""
  1. .S SRUTR=$P($G(SROOC(31)),U)_"@"_SROC(12) I SRUTR="@" S SRUTR=""
  1. .S SRCAR=$P($G(SROOC(32)),U)_"@"_SROC(20) I SRCAR="@" S SRCAR=""
  1. .S SROTH=$P($G(SROOC(21)),U)_"@"_SROC(26) I SROTH="@" S SROTH=""
  1. .S SRDIV=$P($G(^SRF(SRTN,8)),"^")
  1. .S SRI=SRI+1,^TMP("SRA",$J,SRI)=SITE_"^"_SRDIV_"^"_SRTN_"^"_SRRES_"^"_SRCNS_"^"_SRUTR_"^"_SRCAR_"^"_SROTH
  1. ACK ;
  1. S XMSUB="*** SR*3*61 FROM VAMC-"_SITE_" ***",XMDUZ=^XMB("NETNAME")
  1. S XMY("G.SRCOSERV@ISC-CHICAGO.DOMAIN.EXT")=""
  1. S XMTEXT="^TMP(""SRA"",$J," N I D ^XMD
  1. K ^TMP("SRA"),SRTN,SITE,SRCAR,SRCNS,SRDA,SRDFN,SRI,SROC,SROOC,SROTH,SRRES,SRSDATE,SRTDT,SRUTR,SRZ,SRZZ,SRDIV
  1. S ZTREQ="@"
  1. Q
  1. POST ; postinit action for SR*3*61
  1. S ^DD(130,0,"ID",26)="W:$D(^(""OP"")) "" "",$P(^(""OP""),U,1)"
  1. S ZTRTN="EN1^SR61UTL",ZTDESC="Surgery Risk Assessment Retransmission Routine",ZTIO="" S:$G(XPDQUES("POS1")) ZTDTH=XPDQUES("POS1")
  1. D ^%ZTLOAD
  1. Q