RMPR29CB ;OI-HINES/HNC/SPS -WORK ORDER SUSPENSE RPC CONT.;06/06/2006
 ;;3.0;PROSTHETICS;**75**;Feb 09, 1996;Build 25
CANOTE ;(#12) CANCELLATION NOTE
 ;set file 668
 ;^RMPR(668,D0,4,0)=^668.012^^
 ;if status is cancelled, RMSUSTAT= 3 or 4
 ;RMPRTXT ;load into field #12
 ;^RMPR(668,D0,4,D1,0)
 ;
 S RMWONE=$P(^RMPR(664.1,RMPR6641,0),U,13)
 I RMSUSTAT=4 D EN2^RMPROWL(RMIE68,RMWONE)
 I $P(^RMPR(668,RMIE68,0),U,10)="C" S RESULTS(0)="0^This Suspense has already been Closed!"
 ;Update file 664.1 664.2 Delete 660 on Cancel out
 S DIE="^RMPR(664.1,",DA=RMPR6641
 S DR="16////^S X=""CA"";7////^S X=DUZ;8///^S X=DT" D ^DIE
 K DR,DA,DIE
 S RMIE=0,DIK="^RMPR(660,"
 F  S RMIE=$O(^RMPR(664.1,RMPR6641,2,RMIE)) Q:RMIE'>0  D
 .S DA=$P(^RMPR(664.1,RMPR6641,2,RMIE,0),U,5) D ^DIK
 .S $P(^RMPR(664.1,RMPR6641,2,RMIE,0),U,5)=""
 .S RMPRIE2=$P($G(^RMPR(664.1,RMPR6641,2,RMIE,0)),U,6)
 .I +RMPRIE2>0 S $P(^RMPR(664.2,RMPRIE2,0),U,2)=""
 .K ^RMPR(664.2,"C",DA)
 K DIK
 S DA=RMIE68
 D NOW^%DTC S RMPREODT=%,GMRCAD=%
 S DIE="^RMPR(668,"
 S DR="18////^S X=RMPREODT;17////^S X=DUZ;14///^S X=""X""" D ^DIE
 N RMPRC
 S L="",LN=0
 F  S L=$O(RMPRTXT(L)) Q:L=""  D
 . I 'LN D  Q:RMPRC=""  ;strip leading space from 1st line, ignore blank line
 .. S RMPRC=$E($TR(RMPRTXT(L)," ","")) ;1st non space char
 .. 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
 .. Q
 . S LN=LN+1,^RMPR(668,RMIE68,4,LN,0)=RMPRTXT(L)
 . Q
 S $P(^RMPR(668,RMIE68,4,0),"^",3)=LN
 K L,LN
 ;S DA=RMIE68,DIK="^RMPR(668," D IX1^DIK
 I '$P(^RMPR(668,DA,0),U,9) D
 .S DIE="^RMPR(668,"
 .S DR="7///^S X=""See Completion Note for Initial Action Taken."""
 .D ^DIE
 .S DR="10////^S X=RMPREODT;16////^S X=DUZ" D ^DIE
 K RMPREODT
 S GMRCO=$P(^RMPR(668,RMIE68,0),U,15)
 I GMRCO="" S RESULTS(0)="0^Completed Manual Suspense Action.  Suspense status has been updated to CANCELLED." Q
 S RMPRCOM=0
 F  S RMPRCOM=$O(^RMPR(668,RMIE68,4,RMPRCOM)) Q:RMPRCOM=""  D
 .S GMRCOM(RMPRCOM)=^RMPR(668,RMIE68,4,RMPRCOM,0)
 I $G(GMRCOM)="" S GMRCOM="Not Noted"
 S GMRCSF="U"
 S GMRCA=19
 S GMRCALF="N"
 S GMRCATO=""
 S (GMRCORNP,GMRCDUZ)=DUZ
 S BDC=$$SFILE^GMRCGUIB(.GMRCO,.GMRCA,.GMRCSF,.GMRCORNP,.GMRCDUZ,.GMRCOM,.GMRCALF,.GMRCATO,.GMRCAD)
 I +BDC=1 S RESULTS(0)=1_"^"_$P(BDC,U,2)
 K GMRCO,GMRCA,GMRCSF,GMRCORNP,GMRCDUZ,GMRCOM,GMRCALF,GMRCATO,GMRCAD
 I RESULTS(0)="" S RESULTS(0)="0^Completed Suspense Action, and Posted note to CPRS Consult.  Suspense status has been updated to CANCELLED."
 Q
EXIT K RMTYRE,RMTRES,RMSUSTAT,RMSTAT,RMSERV,RMEQU,RMPRTST,RMPRDUZ,RMPRDI,RMPRCO,RMPR6641,RMIE68
 K RMIE60,RMIE,RMICD9,RMDWRT,RMDAT,RMCODT,RMAMIS,RMAA,RM688,RMPRTXT
 K BDC,BAD,%,RMINDT,RMPREQU,RMPRCOM,RMWONE,RMPRIE2