| 1 | RMPR29CB ;OI-HINES/HNC/SPS -WORK ORDER SUSPENSE RPC CONT.;06/06/2006
|
|---|
| 2 | ;;3.0;PROSTHETICS;**75**;Feb 09, 1996;Build 25
|
|---|
| 3 | CANOTE ;(#12) CANCELLATION NOTE
|
|---|
| 4 | ;set file 668
|
|---|
| 5 | ;^RMPR(668,D0,4,0)=^668.012^^
|
|---|
| 6 | ;if status is cancelled, RMSUSTAT= 3 or 4
|
|---|
| 7 | ;RMPRTXT ;load into field #12
|
|---|
| 8 | ;^RMPR(668,D0,4,D1,0)
|
|---|
| 9 | ;
|
|---|
| 10 | S RMWONE=$P(^RMPR(664.1,RMPR6641,0),U,13)
|
|---|
| 11 | I RMSUSTAT=4 D EN2^RMPROWL(RMIE68,RMWONE)
|
|---|
| 12 | I $P(^RMPR(668,RMIE68,0),U,10)="C" S RESULTS(0)="0^This Suspense has already been Closed!"
|
|---|
| 13 | ;Update file 664.1 664.2 Delete 660 on Cancel out
|
|---|
| 14 | S DIE="^RMPR(664.1,",DA=RMPR6641
|
|---|
| 15 | S DR="16////^S X=""CA"";7////^S X=DUZ;8///^S X=DT" D ^DIE
|
|---|
| 16 | K DR,DA,DIE
|
|---|
| 17 | S RMIE=0,DIK="^RMPR(660,"
|
|---|
| 18 | F S RMIE=$O(^RMPR(664.1,RMPR6641,2,RMIE)) Q:RMIE'>0 D
|
|---|
| 19 | .S DA=$P(^RMPR(664.1,RMPR6641,2,RMIE,0),U,5) D ^DIK
|
|---|
| 20 | .S $P(^RMPR(664.1,RMPR6641,2,RMIE,0),U,5)=""
|
|---|
| 21 | .S RMPRIE2=$P($G(^RMPR(664.1,RMPR6641,2,RMIE,0)),U,6)
|
|---|
| 22 | .I +RMPRIE2>0 S $P(^RMPR(664.2,RMPRIE2,0),U,2)=""
|
|---|
| 23 | .K ^RMPR(664.2,"C",DA)
|
|---|
| 24 | K DIK
|
|---|
| 25 | S DA=RMIE68
|
|---|
| 26 | D NOW^%DTC S RMPREODT=%,GMRCAD=%
|
|---|
| 27 | S DIE="^RMPR(668,"
|
|---|
| 28 | S DR="18////^S X=RMPREODT;17////^S X=DUZ;14///^S X=""X""" D ^DIE
|
|---|
| 29 | N RMPRC
|
|---|
| 30 | S L="",LN=0
|
|---|
| 31 | F S L=$O(RMPRTXT(L)) Q:L="" D
|
|---|
| 32 | . I 'LN D Q:RMPRC="" ;strip leading space from 1st line, ignore blank line
|
|---|
| 33 | .. S RMPRC=$E($TR(RMPRTXT(L)," ","")) ;1st non space char
|
|---|
| 34 | .. S:RMPRC'="" RMPRTXT(L)=$E(RMPRTXT(L),$F(RMPRTXT(L),RMPRC)-1,$L(RMPRTXT(L))) ;extract from 1st non space char to end of line
|
|---|
| 35 | .. Q
|
|---|
| 36 | . S LN=LN+1,^RMPR(668,RMIE68,4,LN,0)=RMPRTXT(L)
|
|---|
| 37 | . Q
|
|---|
| 38 | S $P(^RMPR(668,RMIE68,4,0),"^",3)=LN
|
|---|
| 39 | K L,LN
|
|---|
| 40 | ;S DA=RMIE68,DIK="^RMPR(668," D IX1^DIK
|
|---|
| 41 | I '$P(^RMPR(668,DA,0),U,9) D
|
|---|
| 42 | .S DIE="^RMPR(668,"
|
|---|
| 43 | .S DR="7///^S X=""See Completion Note for Initial Action Taken."""
|
|---|
| 44 | .D ^DIE
|
|---|
| 45 | .S DR="10////^S X=RMPREODT;16////^S X=DUZ" D ^DIE
|
|---|
| 46 | K RMPREODT
|
|---|
| 47 | S GMRCO=$P(^RMPR(668,RMIE68,0),U,15)
|
|---|
| 48 | I GMRCO="" S RESULTS(0)="0^Completed Manual Suspense Action. Suspense status has been updated to CANCELLED." Q
|
|---|
| 49 | S RMPRCOM=0
|
|---|
| 50 | F S RMPRCOM=$O(^RMPR(668,RMIE68,4,RMPRCOM)) Q:RMPRCOM="" D
|
|---|
| 51 | .S GMRCOM(RMPRCOM)=^RMPR(668,RMIE68,4,RMPRCOM,0)
|
|---|
| 52 | I $G(GMRCOM)="" S GMRCOM="Not Noted"
|
|---|
| 53 | S GMRCSF="U"
|
|---|
| 54 | S GMRCA=19
|
|---|
| 55 | S GMRCALF="N"
|
|---|
| 56 | S GMRCATO=""
|
|---|
| 57 | S (GMRCORNP,GMRCDUZ)=DUZ
|
|---|
| 58 | S BDC=$$SFILE^GMRCGUIB(.GMRCO,.GMRCA,.GMRCSF,.GMRCORNP,.GMRCDUZ,.GMRCOM,.GMRCALF,.GMRCATO,.GMRCAD)
|
|---|
| 59 | I +BDC=1 S RESULTS(0)=1_"^"_$P(BDC,U,2)
|
|---|
| 60 | K GMRCO,GMRCA,GMRCSF,GMRCORNP,GMRCDUZ,GMRCOM,GMRCALF,GMRCATO,GMRCAD
|
|---|
| 61 | I RESULTS(0)="" S RESULTS(0)="0^Completed Suspense Action, and Posted note to CPRS Consult. Suspense status has been updated to CANCELLED."
|
|---|
| 62 | Q
|
|---|
| 63 | EXIT K RMTYRE,RMTRES,RMSUSTAT,RMSTAT,RMSERV,RMEQU,RMPRTST,RMPRDUZ,RMPRDI,RMPRCO,RMPR6641,RMIE68
|
|---|
| 64 | K RMIE60,RMIE,RMICD9,RMDWRT,RMDAT,RMCODT,RMAMIS,RMAA,RM688,RMPRTXT
|
|---|
| 65 | K BDC,BAD,%,RMINDT,RMPREQU,RMPRCOM,RMWONE,RMPRIE2
|
|---|
