| [613] | 1 | RORRP037 ;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 | ;
|
|---|
| 31 | SAVE(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 | ;
|
|---|
| 68 | SAVE1(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
|
|---|
