source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR29CB.m@ 789

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

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1RMPR29CB ;OI-HINES/HNC/SPS -WORK ORDER SUSPENSE RPC CONT.;06/06/2006
2 ;;3.0;PROSTHETICS;**75**;Feb 09, 1996;Build 25
3CANOTE ;(#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
63EXIT 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
Note: See TracBrowser for help on using the repository browser.