source: WorldVistAEHR/trunk/r/CMOP-PSX/PSXCH.m@ 975

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

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1PSXCH ;BIR/WPB-Routine to Change CMOP RX Suspense Dates ; [ 04/08/97 2:06 PM ]
2 ;;2.0;CMOP;;11 Apr 97
3 ;variable XOK is set based on the value of the CMOP indicator
4 ;and directs processing in the PSOSUCHG routine so that the CMOP
5 ;rxs are processed properly.
6P ;
7 S PSXC=$P($G(^PS(52.5,SFN,0)),U,7),XOK=0
8 I "QP"[PSXC S XOK=1 G RTN^PSOSUCHG
9 I "LRX"[PSXC S MESS=$S(PSXC="L":"Rx is being transmitted to the CMOP and CAN NOT be edited.",(PSXC="X")!(PSXC="R"):"Rx has been transmitted to the CMOP and CAN NOT be edited.",1:0) W !,MESS
10 I XOK=0 K X,Y,RXDATE,RXREC G:ACT="A" ALL^PSOSUCHG D:ACT="S" SPEC^PSOSUCHG
11 Q
12AC ;
13 K:"XRL"[PSXC ^PS(52.5,"AC",$P(^PS(52.5,SFN,0),"^",3),$P(^PS(52.5,SFN,0),"^",2),SFN)
14 Q
15X ;
16 S DA=SFN
17 ;following hard kills kill off the old xref
18 I PSXC="P" K ^PS(52.5,"AP",OLD,$P(^PS(52.5,DA,0),U,3),DA)
19 I PSXC="Q" K ^PS(52.5,"AQ",OLD,$P(^PS(52.5,DA,0),U,3),DA)
20 ;I PSXC="R" K ^PS(52.5,"AR",OLD,$P(^PS(52.5,DA,0),U,3),DA)
21 S DA=SFN,DIK(1)="3^AP^AQ^AG",DIK="^PS(52.5," D EN^DIK K DIK,DA,DIK(1)
22 I $G(PSXC)'="" K ^PS(52.5,"AC",$P(^PS(52.5,SFN,0),U,3),$P(^PS(52.5,SFN,0),U,2),SFN),PSXC,DA,XOK,SFN,MESS,OLD
23 Q
24A ;
25 S PSXC=$P($G(^PS(52.5,SFN,0)),U,7),XOK=0
26 S:PSXC="" XOK=2
27 S:(PSXC'="")&("QP"[PSXC) XOK=1
28 D:XOK'=0 AC
29 Q
Note: See TracBrowser for help on using the repository browser.