[623] | 1 | SROXR4 ;BIR/MAM - CROSS REFERENCES ;03/15/06
|
---|
| 2 | ;;3.0; Surgery ;**62,83,100,153**;24 Jun 93;Build 11
|
---|
| 3 | Q
|
---|
| 4 | PRO ; 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
|
---|
| 9 | CAN ; '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
|
---|
| 15 | KCAN ; '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
|
---|
| 19 | AS ; '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
|
---|
| 24 | KAS ; '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
|
---|
| 29 | SCH ; '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
|
---|
| 33 | KSCH ; '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
|
---|
| 37 | RISK ; 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
|
---|
| 40 | AQ ; 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
|
---|
| 43 | KAQ ; 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
|
---|
| 46 | AQDT ; 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
|
---|
| 52 | AQ1 ; 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
|
---|
| 55 | KAQ1 ; kill logic for AQ1 x-ref
|
---|
| 56 | N SRTD,SRLO D AQDT K ^SRF("AQ",SRTD,DA)
|
---|
| 57 | Q
|
---|