source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGENPTA1.m@ 1801

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

initial load of WorldVistAEHR

File size: 4.4 KB
RevLine 
[613]1DGENPTA1 ;ALB/CJM,EG,CKN - Patient API - File Data; 04/24/2006 2:28 PM
2 ;;5.3;Registration;**121,147,314,677,659,653**;Aug 13,1993;Build 2
3 ;
4LOCK(DFN) ;
5 ;Description: Given an internal entry number of a PATIENT record, this
6 ; function will lock the record. It should be used when updating the
7 ; record.
8 ;Input:
9 ; DFN - Patient IEN
10 ;Output:
11 ; Function Value - Returns 1 if the lock was successful, 0 otherwise
12 ;
13 I $G(DFN) L +^DPT(DFN):2
14 Q $T
15UNLOCK(DFN) ;
16 ;Description: Given an internal entry number of a record in the PATIENT
17 ; file, this function will unlock the record that was previously
18 ; locked by LOCK PATIENT RECORD.
19 ;Input:
20 ; DFN - Patient IEN
21 ;Output: None
22 ;
23 I $G(DFN) L -^DPT(DFN)
24 Q
25 ;
26STOREPRE(DFN,DGPREFAC) ;
27 ;Description: Used to store the patient's preferred facility in the
28 ; patient record.
29 ;Input:
30 ; DFN - Patient IEN
31 ; DGPREFAC - pointer to the a record in the INSTITUTION file.
32 ;Output:
33 ; Function Value - Returns 1 on success, 0 on failure.
34 ;
35 N SUCCESS,DATA
36 S SUCCESS=1
37 D ;drops out if invalid condition found
38 . I $G(DFN),$D(^DPT(DFN,0))
39 . E S SUCCESS=0 Q
40 . I ($G(DGPREFAC)'=""),'$G(DGPREFAC) S SUCCESS=0 Q
41 . I $G(DGPREFAC),'$D(^DIC(4,DGPREFAC,0)) S SUCCESS=0 Q
42 . S DATA(27.02)=DGPREFAC
43 . S SUCESS=$$UPD^DGENDBS(2,DFN,.DATA)
44 Q SUCCESS
45 ;
46CHECK(DGPAT,ERROR) ;
47 ;Description: Does validation checks on the patient contained in the
48 ;DGPAT array.
49 ;
50 ;Input:
51 ; DGPAT - this local array contains patient data
52 ;Output:
53 ; Function Value - returns 1 if all validation checks passed, 0 otherwise
54 ; ERROR - if validation checks fail, an error message is returned (pass by reference)
55 ;
56 ;
57 N SUCCESS,FIELD
58 S SUCCESS=1
59 S ERROR=""
60 ;
61 ;check field values
62 ;
63 ;some of the field's input transforms require DA or DUZ to be defined, so do not do this
64 ;F S SUB=$O(DGPAT(SUB)) Q:SUB="" D:(DGPAT(SUB)'="") Q:'SUCCESS
65 ;.S FIELD=$$FIELD(SUB)
66 ;.I '$$TESTVAL^DGENDBS(2,FIELD,DGPAT(SUB)) D
67 ;..S SUCCESS=0
68 ;..S ERROR="BAD FIELD VALUE, PATIENT FILE FIELD = "_$$GET1^DID(2,FIELD,,"LABEL")
69 ;
70 ;instead, check field values without referencing DD
71 I DGPAT("INELDEC")'="",($L(DGPAT("INELDEC"))>75)!($L(DGPAT("INELDEC"))<3) S SUCCESS=0,ERROR="BAD FIELD VALUE, PATIENT FIELD FIELD = INELIGIBLE VARO DECISION" G QCHECK
72 ;
73 I DGPAT("INELREA")'="",($L(DGPAT("INELREA"))>40) S SUCCESS=0,ERROR="BAD FIELD VALUE, PATIENT FIELD FIELD = INELIGIBLE REASON" G QCHECK
74 ;
75 I DGPAT("VETERAN")="" S SUCCESS=0,ERROR="BAD FIELD VALUE, PATIENT FIELD = VETERAN (Y/N)?" G QCHECK
76 ;
77 I DGPAT("DEATH"),(DGPAT("DEATH")>DT) S SUCCESS=0,ERROR="DATE OF DEATH CAN NOT BE A FUTURE DATE" G QCHECK
78 ;
79 I DGPAT("INELDATE"),(DGPAT("INELREA")="") S SUCCESS=0,ERROR="INELIGIBLE REASON UNSPECIFIED FOR INELIGIBLE PATIENT" G QCHECK
80 ;
81QCHECK ;
82 Q SUCCESS
83 ;
84STORE(DGPAT,ERROR,NOCHECK) ;
85 ;Description: Files data in the patient record. It requires a lock
86 ;on the Patient record, adn releases the lock when done.
87 ;
88 ;Input:
89 ; DGPAT- the patient array, passed by reference
90 ; NOCHECK - a flag, if set to 1 it means consistency checks were done aready, so skip
91 ;
92 ;Output:
93 ; Function Value - returns 1 if successful, otherwise 0
94 ; ERROR - on failure, an error message is returned (optional, pass by reference)
95 ;
96 S ERROR=""
97 I '$D(DGPAT) S ERROR="PATIENT NOT FOUND" Q 0
98 I '$$LOCK(DGPAT("DFN")) S ERROR="UNABLE TO LOCK THE PATIENT RECORD" Q 0
99 I $G(NOCHECK)'=1 Q:'$$CHECK(.DGPAT,.ERROR) 0
100 ;
101 N DATA,SUB,FIELD,SUCCESS
102 S SUB=""
103 ;
104 F S SUB=$O(DGPAT(SUB)) Q:(SUB="") I SUB'="DEATH" S FIELD=$$FIELD(SUB) I FIELD S DATA(FIELD)=$G(DGPAT(SUB))
105 S SUCCESS=$$UPD^DGENDBS(2,DGPAT("DFN"),.DATA)
106 I 'SUCCESS S ERROR="FILEMAN UNABLE TO UPDATE PATIENT RECORD"
107 ; Call Purple Heart API to file PH data in file 2
108 I SUCCESS,$D(DGPAT("PHI")) D EDITPH^DGRPLE($G(DGPAT("PHI")),$G(DGPAT("PHST")),$G(DGPAT("PHRR")),DGPAT("DFN"))
109 ; Call POW API to file POW data in file 2 - DG*5.3*653
110 I SUCCESS,$D(DGPAT("POWI")) D EDITPOW^DGRPLE($G(DGPAT("POWI")),$G(DGPAT("POWLOC")),$G(DGPAT("POWFDT")),$G(DGPAT("POWTDT")),DGPAT("DFN"))
111 D UNLOCK(DGPAT("DFN"))
112 Q SUCCESS
113 ;
114FIELD(SUB) ;
115 ;Description: Returns the field number of a subscript for the PATIENT object.
116 ;
117 N FNUM
118 S FNUM=$S(SUB="DEATH":.351,SUB="PATYPE":391,SUB="VETERAN":1901,SUB="NAME":.01,SUB="DOB":.03,SUB="SEX":.02,SUB="SSN":.09,SUB="PREFAC":27.02,SUB="INELDATE":.152,SUB="INELREA":.307,SUB="INELDEC":.1656,SUB="PID":.363,SUB="EMGRES":.181,1:"")
119 I FNUM="" S FNUM=$S(SUB="IR":.32103,SUB="RADEXPM":.3212,SUB="APPREQ":1010.159,SUB="APPREQDT":1010.1511,1:"")
120 Q FNUM
Note: See TracBrowser for help on using the repository browser.