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