source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORRP037.m@ 897

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

initial load of FOIAVistA 6/30/08 version
File size: 3.4 KB
Line 
1RORRP037 ;HCIOFO/SG - RPC: HEPC PATIENT SAVE/CANCEL ; 1/29/07 9:51am
2 ;;1.5;CLINICAL CASE REGISTRIES;**2**;Feb 17, 2006;Build 6
3 ;
4 Q
5 ;
6 ;***** UPDATES THE PATIENT'S REGISTRY DATA
7 ; RPC: [RORHEPC PATIENT SAVE]
8 ;
9 ; .RESULTS Reference to a local variable where the results
10 ; are returned to.
11 ;
12 ; REGIEN Registry IEN
13 ;
14 ; PTIEN IEN of the registry patient (DFN)
15 ;
16 ; [CANCEL] Cancel the update and unlock the registry data
17 ;
18 ; .DATA Reference to a local array that contains the data
19 ; in the same format as the output of the RORHEPC
20 ; PATIENT LOAD remote procedure. Only HEPC and LFV
21 ; segments are processed; the others are ignored.
22 ;
23 ; Return Values:
24 ;
25 ; A negative value of the first "^"-piece of the RESULTS(0)
26 ; indicates an error (see the RPCSTK^RORERR procedure for more
27 ; details).
28 ;
29 ; Otherwise, zero is returned in the RESULTS(0).
30 ;
31SAVE(RESULTS,REGIEN,PTIEN,CANCEL,DATA) ;
32 N IENS,LOCK,RC,RORERRDL
33 D CLEAR^RORERR("SAVE^RORRP037",1)
34 K RESULTS S (RESULTS(0),RC)=0
35 D
36 . ;--- Registry IEN
37 . I $G(REGIEN)'>0 D Q
38 . . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
39 . S REGIEN=+REGIEN
40 . ;--- Patient IEN
41 . I $G(PTIEN)'>0 D Q
42 . . S RC=$$ERROR^RORERR(-88,,,,"PTIEN",$G(PTIEN))
43 . S PTIEN=+PTIEN
44 . ;--- Get the IENS of the registry record
45 . S IENS=$$PRRIEN^RORUTL01(PTIEN,REGIEN)_","
46 . S:IENS>0 LOCK(798,IENS)=""
47 . Q:$G(CANCEL)
48 . ;--- Save the data
49 . S RC=$$SAVE1(.IENS)
50 . I '$D(LOCK) S:IENS>0 LOCK(798,IENS)=""
51 . S:RC>0 RESULTS(0)=RC
52 ;
53 ;--- Do not unlock the records if there are errors in the data
54 ; (positive value is returned by the $$SAVE1), since the user
55 ;--- will have another chance to correct the data and save it.
56 D:RC'>0 UNLOCK^RORLOCK(.LOCK)
57 D:RC<0 RPCSTK^RORERR(.RESULTS,RC)
58 Q
59 ;
60 ;***** INTERNAL ENTRY POINT THAT UPDATES THE REGISTRY DATA
61 ;
62 ; IENS798 IENS of the registry record in the file #798
63 ;
64 ; Return Values:
65 ; <0 Error code
66 ; 0 Ok
67 ;
68SAVE1(IENS798) ;
69 N IENS,LFIEN,LFV,RC,RDI,REGNAME,RORFDA,RORMSG,SEG,TMP
70 ;
71 ;=== Add the patient to the registry if necessary
72 I IENS798'>0 S RC=0 D Q:RC<0 RC
73 . S REGNAME=$P($$REGNAME^RORUTL01(REGIEN),U)
74 . ;--- Add the patient to the registry
75 . S RC=$$ADDPAT^RORUPD06(PTIEN,REGNAME) Q:RC<0
76 . ;--- Get the IENS of the registry record
77 . S IENS798=$$PRRIEN^RORUTL01(PTIEN,REGIEN)_","
78 . S:IENS798'>0 RC=$$ERROR^RORERR(-97,,,PTIEN,REGNAME)
79 ;
80 ;=== Prepare the data
81 S (LFCNT,RDI,RC)=0
82 F S RDI=$O(DATA(RDI)) Q:RDI'>0 D Q:RC
83 . S SEG=$P(DATA(RDI),U)
84 . ;--- Registry data
85 . I SEG="HEPC" D Q
86 . . ; Insert code here if/when necessary
87 . ;--- Local field values
88 . I SEG="LFV" D Q
89 . . S LFIEN=+$P(DATA(RDI),U,3)
90 . . S:LFIEN>0 LFV(LFIEN)=DATA(RDI)
91 Q:RC RC
92 ;
93 ;=== Confirm the pending patient
94 D:$$GET1^DIQ(798,IENS798,3,"I",,"RORMSG")=4
95 . ;--- Do not clear the DON'T SEND flag for 'test' patients
96 . S:'$$TESTPAT^RORUTL01(PTIEN) RORFDA(798,IENS798,11)="@"
97 . ;--- Change the STATUS from 'Pending' to 'Active'
98 . S RORFDA(798,IENS798,3)=0
99 ;
100 ;=== Update local fields
101 S RC=$$UPDLFV^RORUTL19(IENS798,.LFV) Q:RC<0 RC
102 S:RC RORFDA(798,IENS798,5)=1 ; UPDATE LOCAL REGISTRY DATA
103 ;
104 ;=== Update the record(s)
105 I $D(RORFDA)>1 D Q:RC<0 RC
106 . S RORFDA(798,IENS798,5)=1 ; UPDATE LOCAL REGISTRY DATA
107 . D FILE^DIE(,"RORFDA","RORMSG")
108 . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798,IENS798)
109 ;
110 ;=== Success
111 Q 0
Note: See TracBrowser for help on using the repository browser.