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

SROXR4.m

Go to the documentation of this file. 
  1. SROXR4 ;BIR/MAM - CROSS REFERENCES ; January 24, 2011
  1.  ;;3.0;Surgery;**62,83,100,153,166,174,175,176,217**;24 Jun 93;Build 1
  1.  Q
  1. PRO ; stuff default prosthesis info
  1.  I '$D(SRTN) Q
  1.  S ^SRF(SRTN,1,DA,0)=$P(^SRF(SRTN,1,DA,0),U)_"^"_$P(^SRO(131.9,X,0),"^",2,4)_"^^"_$P(^SRO(131.9,X,0),"^",6,99)
  1.  I $D(^SRO(131.9,X,1)) S ^SRF(SRTN,1,DA,1)=^(1)
  1.  Q
  1. CAN ; 'SET' logic of the 'ACAN' x-ref on the 'CANCEL REASON'
  1.  ; field in the SURGERY file (130)
  1.  S $P(^SRF(DA,30),"^",2)=$P(^SRO(135,X,0),"^",3) I $P(^SRO(135,X,0),"^",3)="" S $P(^SRF(DA,30),"^",2)="Y"
  1.  I $P(^SRF(DA,30),"^",3)="" S $P(^SRF(DA,30),"^",3)=DUZ
  1.  D AQ
  1.  S SHEMP=$P($G(^SRF(DA,.2)),"^",10) I SHEMP,$D(^SRF(DA,"RA")) S ZTDESC="Clean up Risk Assessment Information, Canceled Case",ZTRTN="RISK^SROXR4",ZTDTH=$H,ZTSAVE("DA")="" D ^%ZTLOAD
  1.  Q
  1. KCAN ; 'KILL' logic of the 'ACAN' x-ref on the 'CANCEL REASON'
  1.  ; field in the SURGERY file (130)
  1.  S $P(^SRF(DA,30),"^",2)="" I '$P($G(^SRF(DA,30)),"^") S $P(^SRF(DA,30),"^",3)=""
  1.  D KAQ
  1.  Q
  1. AS ; 'SET' logic of the 'AS' x-ref on the SCHEDULED START TIME
  1.  ; field in the SURGERY file (130)
  1.  S OR=$P(^SRF(DA,0),"^",2) I 'OR Q
  1.  S ^SRF("AS",OR,X,DA)=""
  1.  Q
  1. KAS ; 'KILL' logic of the 'AS' x-ref on the SCHEDULED FINISH TIME
  1.  ; field in the SURGERY file (130)
  1.  S OR=$P(^SRF(DA,0),"^",2) I 'OR Q
  1.  K ^SRF("AS",OR,X,DA)
  1.  Q
  1. SCH ; 'SET' logic of the 'AC' x-ref of the REQUIRED FIELDS FOR SCHEDULING
  1.  ; field in the SURGERY SITE PARAMETERS file (133)
  1.  S MM=$O(^DD(130,"B",X,0)),$P(^SRO(133,DA(1),4,DA,0),"^",2)=MM K MM
  1.  Q
  1. KSCH ; 'KILL' logic of the 'AC' x-ref of the REQUIRED FIELDS FOR SCHEDULING
  1.  ; field in the SURGERY SITE PARAMETERS file (133)
  1.  S $P(^SRO(133,DA(1),4,DA,0),"^",2)=""
  1.  Q
  1. RISK ; clean up risk data for canceled cases
  1.  S DIE=130,DR="102///@;235///@;284///@;323///@" D ^DIE K DR,DA S ZTREQ="@"
  1.  Q
  1. AQ ; set logic for AQ x-ref
  1.  N SRTD,SRLO D AQDT I SRTD'<SRLO S $P(^SRF(DA,.4),"^",2)="R",^SRF("AQ",SRTD,DA)=""
  1.  Q
  1. KAQ ; kill logic for AQ x-ref
  1.  N SRTD,SRLO D AQDT S $P(^SRF(DA,.4),"^",2)="" K ^SRF("AQ",SRTD,DA)
  1.  Q
  1. AQDT ; get monthly transmission date 45 days after end of the month of the operation
  1.  N SRD,SRSDATE,SRX,SRYR,M S SRSDATE=$E($P(^SRF(DA,0),"^",9),1,7),SRYR=$E(SRSDATE,1,3),M=+$E(SRSDATE,4,5)
  1.  S SRD=$S(M=1:"0316",M=2:"0414",M=3:"0515",M=4:"0614",M=5:"0715",M=6:"0814",M=7:"0914",M=8:"1015",M=9:"1114",M=10:"1215",M=11:"0114",1:"0214")
  1.  S:M=11!(M=12) SRYR=SRYR+1 S SRTD=SRYR_SRD
  1.  S SRX=$E(DT,1,3),SRLO=SRX-2_"1215"
  1.  Q
  1. AQ1 ; set logic for AQ1 x-ref
  1.  I X="R" N SRTD,SRLO D AQDT I SRTD'<SRLO S ^SRF("AQ",SRTD,DA)=""
  1.  Q
  1. KAQ1 ; kill logic for AQ1 x-ref
  1.  N SRTD,SRLO D AQDT K ^SRF("AQ",SRTD,DA)
  1.  Q
  1. AT ; set logic for AT x-ref on DATE OF LAST TRANSMISSION
  1.  N SRX S ^SRF("AT",X,DA)=""
  1.  S SRX=$P($G(^SRF(DA,"RA")),"^",4) I SRX,SRX'=X K ^SRF("AT",SRX,DA)
  1.  Q
  1. KAT ; kill logic for AT x-ref on DATE OF LAST TRANSMISSION
  1.  N SRX K ^SRF("AT",X,DA)
  1.  S SRX=$P($G(^SRF(DA,"RA")),"^",4) I SRX,SRX'=X K ^SRF("AT",SRX,DA)
  1.  Q
  1. AT1 ; set logic for AT x-ref on DATE TRANSMITTED
  1.  N SRX S SRX=$P($G(^SRF(DA,"RA")),"^",8) I SRX Q
  1.  S ^SRF("AT",X,DA)=""
  1.  Q
  1. KAT1 ; kill logic for AT x-ref on DATE TRANSMITTED
  1.  N SRX S SRX=$P($G(^SRF(DA,"RA")),"^",8)
  1.  I SRX'=X K ^SRF("AT",X,DA)
  1.  Q