| [613] | 1 | PSXCH ;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.
|
|---|
| 6 | P ;
|
|---|
| 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
|
|---|
| 12 | AC ;
|
|---|
| 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
|
|---|
| 15 | X ;
|
|---|
| 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
|
|---|
| 24 | A ;
|
|---|
| 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
|
|---|
