source: FOIAVistA/trunk/r/SURGERY-SR/SROXR4.m@ 1590

Last change on this file since 1590 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.9 KB
Line 
1SROXR4 ;BIR/MAM - CROSS REFERENCES ;11/05/07
2 ;;3.0; Surgery ;**62,83,100,153,166**;24 Jun 93;Build 6
3 Q
4PRO ; stuff default prosthesis info
5 I '$D(SRTN) Q
6 S ^SRF(SRTN,1,DA,0)=^SRF(SRTN,1,DA,0)_"^"_$P(^SRO(131.9,X,0),"^",2,99)
7 I $D(^SRO(131.9,X,1)) S ^SRF(SRTN,1,DA,1)=^(1)
8 Q
9CAN ; 'SET' logic of the 'ACAN' x-ref on the 'CANCEL REASON'
10 ; field in the SURGERY file (130)
11 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"
12 I $P(^SRF(DA,30),"^",3)="" S $P(^SRF(DA,30),"^",3)=DUZ
13 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
14 Q
15KCAN ; 'KILL' logic of the 'ACAN' x-ref on the 'CANCEL REASON'
16 ; field in the SURGERY file (130)
17 S $P(^SRF(DA,30),"^",2)="" I '$P($G(^SRF(DA,30)),"^") S $P(^SRF(DA,30),"^",3)=""
18 Q
19AS ; 'SET' logic of the 'AS' x-ref on the SCHEDULED START TIME
20 ; field in the SURGERY file (130)
21 S OR=$P(^SRF(DA,0),"^",2) I 'OR Q
22 S ^SRF("AS",OR,X,DA)=""
23 Q
24KAS ; 'KILL' logic of the 'AS' x-ref on the SCHEDULED FINISH TIME
25 ; field in the SURGERY file (130)
26 S OR=$P(^SRF(DA,0),"^",2) I 'OR Q
27 K ^SRF("AS",OR,X,DA)
28 Q
29SCH ; 'SET' logic of the 'AC' x-ref of the REQUIRED FIELDS FOR SCHEDULING
30 ; field in the SURGERY SITE PARAMETERS file (133)
31 S MM=$O(^DD(130,"B",X,0)),$P(^SRO(133,DA(1),4,DA,0),"^",2)=MM K MM
32 Q
33KSCH ; 'KILL' logic of the 'AC' x-ref of the REQUIRED FIELDS FOR SCHEDULING
34 ; field in the SURGERY SITE PARAMETERS file (133)
35 S $P(^SRO(133,DA(1),4,DA,0),"^",2)=""
36 Q
37RISK ; clean up risk data for canceled cases
38 S DIE=130,DR="102///@;235///@;284///@;323///@" D ^DIE K DR,DA S ZTREQ="@"
39 Q
40AQ ; set logic for AQ x-ref
41 N SRTD,SRLO D AQDT I SRTD'<SRLO S $P(^SRF(DA,.4),"^",2)="R",^SRF("AQ",SRTD,DA)=""
42 Q
43KAQ ; kill logic for AQ x-ref
44 N SRTD,SRLO D AQDT S $P(^SRF(DA,.4),"^",2)="" K ^SRF("AQ",SRTD,DA)
45 Q
46AQDT ; get quarterly transmission date
47 N SRDAY,SRSDATE,SRQTR,SRX,SRYR S SRSDATE=$E($P(^SRF(DA,0),"^",9),1,7)
48 S SRYR=$E(SRSDATE,1,3),SRDAY=$E(SRSDATE,4,7),SRQTR=$S(SRDAY<401:2,SRDAY<701:3,SRDAY<1001:4,1:1) I SRQTR=1 S SRYR=SRYR+1
49 S SRTD=SRYR_$S(SRQTR=1:"0214",SRQTR=2:"0515",SRQTR=3:"0814",1:"1114")
50 S SRX=$E(DT,1,3),SRLO=SRX-1_"0214"
51 Q
52AQ1 ; set logic for AQ1 x-ref
53 I X="R" N SRTD,SRLO D AQDT I SRTD'<SRLO S ^SRF("AQ",SRTD,DA)=""
54 Q
55KAQ1 ; kill logic for AQ1 x-ref
56 N SRTD,SRLO D AQDT K ^SRF("AQ",SRTD,DA)
57 Q
58AT ; set logic for AT x-ref on DATE OF LAST TRANSMISSION
59 N SRX S ^SRF("AT",X,DA)=""
60 S SRX=$P($G(^SRF(DA,"RA")),"^",4) I SRX,SRX'=X K ^SRF("AT",SRX,DA)
61 Q
62KAT ; kill logic for AT x-ref on DATE OF LAST TRANSMISSION
63 N SRX K ^SRF("AT",X,DA)
64 S SRX=$P($G(^SRF(DA,"RA")),"^",4) I SRX,SRX'=X K ^SRF("AT",SRX,DA)
65 Q
66AT1 ; set logic for AT x-ref on DATE TRANSMITTED
67 N SRX S SRX=$P($G(^SRF(DA,"RA")),"^",8) I SRX Q
68 S ^SRF("AT",X,DA)=""
69 Q
70KAT1 ; kill logic for AT x-ref on DATE TRANSMITTED
71 N SRX S SRX=$P($G(^SRF(DA,"RA")),"^",8)
72 I SRX'=X K ^SRF("AT",X,DA)
73 Q
Note: See TracBrowser for help on using the repository browser.