source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORRP034.m@ 1394

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

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1RORRP034 ;HCIOFO/SG - RPC: HIV PATIENT SAVE/CANCEL ; 1/29/07 9:54am
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: [RORICR 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 RORICR
20 ; PATIENT LOAD remote procedure. Only PH, ICR, and
21 ; LFV 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^RORRP034",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),LOCK(799.4,IENS))=""
47 . Q:$G(CANCEL)
48 . ;--- Save the data
49 . S RC=$$SAVE1(.IENS)
50 . I '$D(LOCK) S:IENS>0 (LOCK(798,IENS),LOCK(799.4,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
61SAVE1(IENS798) ;
62 N IENS,LFIEN,LFV,RC,RDI,REGNAME,RORFDA,RORMSG,SEG,TMP
63 ;
64 ;=== Add the patient to the registry if necessary
65 I IENS798'>0 S RC=0 D Q:RC<0 RC
66 . S REGNAME=$P($$REGNAME^RORUTL01(REGIEN),U)
67 . ;--- Add the patient to the registry
68 . S RC=$$ADDPAT^RORUPD06(PTIEN,REGNAME) Q:RC<0
69 . ;--- Get the IENS of the registry record
70 . S IENS798=$$PRRIEN^RORUTL01(PTIEN,REGIEN)_","
71 . S:IENS798'>0 RC=$$ERROR^RORERR(-97,,,PTIEN,REGNAME)
72 ;
73 ;=== Prepare the data
74 S (LFCNT,RDI,RC)=0
75 F S RDI=$O(DATA(RDI)) Q:RDI'>0 D Q:RC
76 . S SEG=$P(DATA(RDI),U)
77 . ;--- Risk factors
78 . I SEG="PH" D Q
79 . . S RC=$$CDCFDA^RORRP026(IENS798,"PH^RORRP026",DATA(RDI),.RORFDA)
80 . ;--- Registry data
81 . I SEG="ICR" D Q
82 . . S TMP=$P(DATA(RDI),U,3)
83 . . S RORFDA(799.4,IENS798,.02)=TMP
84 . . S RORFDA(799.4,IENS798,.03)=$S(TMP:$P(DATA(RDI),U,4),1:"")
85 . ;--- Local field values
86 . I SEG="LFV" D Q
87 . . S LFIEN=+$P(DATA(RDI),U,3)
88 . . S:LFIEN>0 LFV(LFIEN)=DATA(RDI)
89 Q:RC RC
90 ;
91 ;=== Confirm the pending patient
92 D:$$GET1^DIQ(798,IENS798,3,"I",,"RORMSG")=4
93 . ;--- Do not clear the DON'T SEND flag for 'test' patients
94 . S:'$$TESTPAT^RORUTL01(PTIEN) RORFDA(798,IENS798,11)="@"
95 . ;--- Change the STATUS from 'Pending' to 'Active'
96 . S RORFDA(798,IENS798,3)=0
97 ;
98 ;=== Update local fields
99 S RC=$$UPDLFV^RORUTL19(IENS798,.LFV) Q:RC<0 RC
100 S:RC RORFDA(798,IENS798,5)=1 ; UPDATE LOCAL REGISTRY DATA
101 ;
102 ;=== Update the record(s)
103 I $D(RORFDA)>1 D Q:RC<0 RC
104 . S RORFDA(798,IENS798,5)=1 ; UPDATE LOCAL REGISTRY DATA
105 . D FILE^DIE(,"RORFDA","RORMSG")
106 . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,"798&799.4",IENS798)
107 ;
108 ;=== Success
109 Q 0
Note: See TracBrowser for help on using the repository browser.