DGENPTA1 ;ALB/CJM,EG,CKN,ERC,TDM,PWC - Patient API - File Data ; 2/3/11 6:45pm
;;5.3;PIMS;**121,147,314,677,659,653,688,1015,1016**;JUN 30, 2012;Build 20
;
LOCK(DFN) ;
;Description: Given an internal entry number of a PATIENT record, this
; function will lock the record. It should be used when updating the
; record.
;Input:
; DFN - Patient IEN
;Output:
; Function Value - Returns 1 if the lock was successful, 0 otherwise
;
I $G(DFN) L +^DPT(DFN):2
Q $T
UNLOCK(DFN) ;
;Description: Given an internal entry number of a record in the PATIENT
; file, this function will unlock the record that was previously
; locked by LOCK PATIENT RECORD.
;Input:
; DFN - Patient IEN
;Output: None
;
I $G(DFN) L -^DPT(DFN)
Q
;
STOREPRE(DFN,DGPREFAC) ;
;Description: Used to store the patient's preferred facility in the
; patient record.
;Input:
; DFN - Patient IEN
; DGPREFAC - pointer to the record in the INSTITUTION file.
;Output:
; Function Value - Returns 1 on success, 0 on failure.
;
N SUCCESS,DATA
S SUCCESS=1
D ;drops out if invalid condition found
. I $G(DFN),$D(^DPT(DFN,0))
. E S SUCCESS=0 Q
. I ($G(DGPREFAC)'=""),'$G(DGPREFAC) S SUCCESS=0 Q
. I $G(DGPREFAC),'$D(^DIC(4,DGPREFAC,0)) S SUCCESS=0 Q
. S DATA(27.02)=DGPREFAC
. S DATA(27.03)="V" ; DG*5.3*838
. S SUCCESS=$$UPD^DGENDBS(2,DFN,.DATA)
Q SUCCESS
;
CHECK(DGPAT,ERROR) ;
;Description: Does validation checks on the patient contained in the
;DGPAT array.
;
;Input:
; DGPAT - this local array contains patient data
;Output:
; Function Value - returns 1 if all validation checks passed, 0 otherwise
; ERROR - if validation checks fail, an error message is returned (pass by reference)
;
;
N SUCCESS,FIELD
S SUCCESS=1
S ERROR=""
;
;check field values
;
;some of the field's input transforms require DA or DUZ to be defined, so do not do this
;F S SUB=$O(DGPAT(SUB)) Q:SUB="" D:(DGPAT(SUB)'="") Q:'SUCCESS
;.S FIELD=$$FIELD(SUB)
;.I '$$TESTVAL^DGENDBS(2,FIELD,DGPAT(SUB)) D
;..S SUCCESS=0
;..S ERROR="BAD FIELD VALUE, PATIENT FILE FIELD = "_$$GET1^DID(2,FIELD,,"LABEL")
;
;instead, check field values without referencing DD
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
;
I DGPAT("INELREA")'="",($L(DGPAT("INELREA"))>40) S SUCCESS=0,ERROR="BAD FIELD VALUE, PATIENT FIELD FIELD = INELIGIBLE REASON" G QCHECK
;
I DGPAT("VETERAN")="" S SUCCESS=0,ERROR="BAD FIELD VALUE, PATIENT FIELD = VETERAN (Y/N)?" G QCHECK
;
I DGPAT("DEATH"),(DGPAT("DEATH")>DT) S SUCCESS=0,ERROR="DATE OF DEATH CAN NOT BE A FUTURE DATE" G QCHECK
;
I DGPAT("INELDATE"),(DGPAT("INELREA")="") S SUCCESS=0,ERROR="INELIGIBLE REASON UNSPECIFIED FOR INELIGIBLE PATIENT" G QCHECK
;
QCHECK ;
Q SUCCESS
;
STORE(DGPAT,ERROR,NOCHECK) ;
;Description: Files data in the patient record. It requires a lock
;on the Patient record, adn releases the lock when done.
;
;Input:
; DGPAT- the patient array, passed by reference
; NOCHECK - a flag, if set to 1 it means consistency checks were done aready, so skip
;
;Output:
; Function Value - returns 1 if successful, otherwise 0
; ERROR - on failure, an error message is returned (optional, pass by reference)
;
S ERROR=""
I '$D(DGPAT) S ERROR="PATIENT NOT FOUND" Q 0
I '$$LOCK(DGPAT("DFN")) S ERROR="UNABLE TO LOCK THE PATIENT RECORD" Q 0
I $G(NOCHECK)'=1 Q:'$$CHECK(.DGPAT,.ERROR) 0
;
N DATA,SUB,FIELD,SUCCESS
S SUB=""
;
F S SUB=$O(DGPAT(SUB)) Q:(SUB="") I (SUB'="DEATH")&(SUB'="SSN") S FIELD=$$FIELD(SUB) I FIELD S DATA(FIELD)=$G(DGPAT(SUB))
S SUCCESS=$$UPD^DGENDBS(2,DGPAT("DFN"),.DATA)
I 'SUCCESS S ERROR="FILEMAN UNABLE TO UPDATE PATIENT RECORD"
; Call Purple Heart API to file PH data in file 2
I SUCCESS,$D(DGPAT("PHI")) D EDITPH^DGRPLE($G(DGPAT("PHI")),$G(DGPAT("PHST")),$G(DGPAT("PHRR")),DGPAT("DFN"))
; Call POW API to file POW data in file 2 - DG*5.3*653
;I SUCCESS,$D(DGPAT("POWI")) D EDITPOW^DGRPLE($G(DGPAT("POWI")),$G(DGPAT("POWLOC")),$G(DGPAT("POWFDT")),$G(DGPAT("POWTDT")),DGPAT("DFN"))
I SUCCESS D
. I '$D(DGPAT("POWI")) D Q
. . N DATA,ERROR,DGENDA
. . S DGENDA=DGPAT("DFN")
. . S (DATA(.525),DATA(.526),DATA(.527),DATA(.528),DATA(.529))="@"
. . I '$$UPD^DGENDBS(2,.DGENDA,.DATA,.ERROR) D
. . . D ADDMSG^DGENUPL3(.MSGS,"Unable to update POW Data.",1)
. . K DATA,ERROR,DGENDA
. D EDITPOW^DGRPLE($G(DGPAT("POWI")),$G(DGPAT("POWLOC")),$G(DGPAT("POWFDT")),$G(DGPAT("POWTDT")),DGPAT("DFN"))
D UNLOCK(DGPAT("DFN"))
Q SUCCESS
;
FIELD(SUB) ;
;Description: Returns the field number of a subscript for the PATIENT object.
;
N FNUM
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="AG/ALLY":.309,1:"")
S:'FNUM FNUM=$S(SUB="INELDATE":.152,SUB="INELREA":.307,SUB="INELDEC":.1656,SUB="PID":.363,SUB="EMGRES":.181,1:"")
I FNUM="" S FNUM=$S(SUB="IR":.32103,SUB="RADEXPM":.3212,SUB="APPREQ":1010.159,SUB="APPREQDT":1010.1511,SUB="SPININJ":57.4,SUB="PFSRC":27.03,1:"")
Q FNUM
DGENPTA1 ;ALB/CJM,EG,CKN,ERC,TDM,PWC - Patient API - File Data ; 2/3/11 6:45pm
+1 ;;5.3;PIMS;**121,147,314,677,659,653,688,1015,1016**;JUN 30, 2012;Build 20
+2 ;
LOCK(DFN) ;
+1 ;Description: Given an internal entry number of a PATIENT record, this
+2 ; function will lock the record. It should be used when updating the
+3 ; record.
+4 ;Input:
+5 ; DFN - Patient IEN
+6 ;Output:
+7 ; Function Value - Returns 1 if the lock was successful, 0 otherwise
+8 ;
+9 IF $GET(DFN)
LOCK +^DPT(DFN):2
+10 QUIT $TEST
UNLOCK(DFN) ;
+1 ;Description: Given an internal entry number of a record in the PATIENT
+2 ; file, this function will unlock the record that was previously
+3 ; locked by LOCK PATIENT RECORD.
+4 ;Input:
+5 ; DFN - Patient IEN
+6 ;Output: None
+7 ;
+8 IF $GET(DFN)
LOCK -^DPT(DFN)
+9 QUIT
+10 ;
STOREPRE(DFN,DGPREFAC) ;
+1 ;Description: Used to store the patient's preferred facility in the
+2 ; patient record.
+3 ;Input:
+4 ; DFN - Patient IEN
+5 ; DGPREFAC - pointer to the record in the INSTITUTION file.
+6 ;Output:
+7 ; Function Value - Returns 1 on success, 0 on failure.
+8 ;
+9 NEW SUCCESS,DATA
+10 SET SUCCESS=1
+11 ;drops out if invalid condition found
Begin DoDot:1
+12 IF $GET(DFN)
IF $DATA(^DPT(DFN,0))
+13 IF '$TEST
SET SUCCESS=0
QUIT
+14 IF ($GET(DGPREFAC)'="")
IF '$GET(DGPREFAC)
SET SUCCESS=0
QUIT
+15 IF $GET(DGPREFAC)
IF '$DATA(^DIC(4,DGPREFAC,0))
SET SUCCESS=0
QUIT
+16 SET DATA(27.02)=DGPREFAC
+17 ; DG*5.3*838
SET DATA(27.03)="V"
+18 SET SUCCESS=$$UPD^DGENDBS(2,DFN,.DATA)
End DoDot:1
+19 QUIT SUCCESS
+20 ;
CHECK(DGPAT,ERROR) ;
+1 ;Description: Does validation checks on the patient contained in the
+2 ;DGPAT array.
+3 ;
+4 ;Input:
+5 ; DGPAT - this local array contains patient data
+6 ;Output:
+7 ; Function Value - returns 1 if all validation checks passed, 0 otherwise
+8 ; ERROR - if validation checks fail, an error message is returned (pass by reference)
+9 ;
+10 ;
+11 NEW SUCCESS,FIELD
+12 SET SUCCESS=1
+13 SET ERROR=""
+14 ;
+15 ;check field values
+16 ;
+17 ;some of the field's input transforms require DA or DUZ to be defined, so do not do this
+18 ;F S SUB=$O(DGPAT(SUB)) Q:SUB="" D:(DGPAT(SUB)'="") Q:'SUCCESS
+19 ;.S FIELD=$$FIELD(SUB)
+20 ;.I '$$TESTVAL^DGENDBS(2,FIELD,DGPAT(SUB)) D
+21 ;..S SUCCESS=0
+22 ;..S ERROR="BAD FIELD VALUE, PATIENT FILE FIELD = "_$$GET1^DID(2,FIELD,,"LABEL")
+23 ;
+24 ;instead, check field values without referencing DD
+25 IF DGPAT("INELDEC")'=""
IF ($LENGTH(DGPAT("INELDEC"))>75)!($LENGTH(DGPAT("INELDEC"))<3)
SET SUCCESS=0
SET ERROR="BAD FIELD VALUE, PATIENT FIELD FIELD = INELIGIBLE VARO DECISION"
GOTO QCHECK
+26 ;
+27 IF DGPAT("INELREA")'=""
IF ($LENGTH(DGPAT("INELREA"))>40)
SET SUCCESS=0
SET ERROR="BAD FIELD VALUE, PATIENT FIELD FIELD = INELIGIBLE REASON"
GOTO QCHECK
+28 ;
+29 IF DGPAT("VETERAN")=""
SET SUCCESS=0
SET ERROR="BAD FIELD VALUE, PATIENT FIELD = VETERAN (Y/N)?"
GOTO QCHECK
+30 ;
+31 IF DGPAT("DEATH")
IF (DGPAT("DEATH")>DT)
SET SUCCESS=0
SET ERROR="DATE OF DEATH CAN NOT BE A FUTURE DATE"
GOTO QCHECK
+32 ;
+33 IF DGPAT("INELDATE")
IF (DGPAT("INELREA")="")
SET SUCCESS=0
SET ERROR="INELIGIBLE REASON UNSPECIFIED FOR INELIGIBLE PATIENT"
GOTO QCHECK
+34 ;
QCHECK ;
+1 QUIT SUCCESS
+2 ;
STORE(DGPAT,ERROR,NOCHECK) ;
+1 ;Description: Files data in the patient record. It requires a lock
+2 ;on the Patient record, adn releases the lock when done.
+3 ;
+4 ;Input:
+5 ; DGPAT- the patient array, passed by reference
+6 ; NOCHECK - a flag, if set to 1 it means consistency checks were done aready, so skip
+7 ;
+8 ;Output:
+9 ; Function Value - returns 1 if successful, otherwise 0
+10 ; ERROR - on failure, an error message is returned (optional, pass by reference)
+11 ;
+12 SET ERROR=""
+13 IF '$DATA(DGPAT)
SET ERROR="PATIENT NOT FOUND"
QUIT 0
+14 IF '$$LOCK(DGPAT("DFN"))
SET ERROR="UNABLE TO LOCK THE PATIENT RECORD"
QUIT 0
+15 IF $GET(NOCHECK)'=1
IF '$$CHECK(.DGPAT,.ERROR)
QUIT 0
+16 ;
+17 NEW DATA,SUB,FIELD,SUCCESS
+18 SET SUB=""
+19 ;
+20 FOR
SET SUB=$ORDER(DGPAT(SUB))
IF (SUB="")
QUIT
IF (SUB'="DEATH")&(SUB'="SSN")
SET FIELD=$$FIELD(SUB)
IF FIELD
SET DATA(FIELD)=$GET(DGPAT(SUB))
+21 SET SUCCESS=$$UPD^DGENDBS(2,DGPAT("DFN"),.DATA)
+22 IF 'SUCCESS
SET ERROR="FILEMAN UNABLE TO UPDATE PATIENT RECORD"
+23 ; Call Purple Heart API to file PH data in file 2
+24 IF SUCCESS
IF $DATA(DGPAT("PHI"))
DO EDITPH^DGRPLE($GET(DGPAT("PHI")),$GET(DGPAT("PHST")),$GET(DGPAT("PHRR")),DGPAT("DFN"))
+25 ; Call POW API to file POW data in file 2 - DG*5.3*653
+26 ;I SUCCESS,$D(DGPAT("POWI")) D EDITPOW^DGRPLE($G(DGPAT("POWI")),$G(DGPAT("POWLOC")),$G(DGPAT("POWFDT")),$G(DGPAT("POWTDT")),DGPAT("DFN"))
+27 IF SUCCESS
Begin DoDot:1
+28 IF '$DATA(DGPAT("POWI"))
Begin DoDot:2
+29 NEW DATA,ERROR,DGENDA
+30 SET DGENDA=DGPAT("DFN")
+31 SET (DATA(.525),DATA(.526),DATA(.527),DATA(.528),DATA(.529))="@"
+32 IF '$$UPD^DGENDBS(2,.DGENDA,.DATA,.ERROR)
Begin DoDot:3
+33 DO ADDMSG^DGENUPL3(.MSGS,"Unable to update POW Data.",1)
End DoDot:3
+34 KILL DATA,ERROR,DGENDA
End DoDot:2
QUIT
+35 DO EDITPOW^DGRPLE($GET(DGPAT("POWI")),$GET(DGPAT("POWLOC")),$GET(DGPAT("POWFDT")),$GET(DGPAT("POWTDT")),DGPAT("DFN"))
End DoDot:1
+36 DO UNLOCK(DGPAT("DFN"))
+37 QUIT SUCCESS
+38 ;
FIELD(SUB) ;
+1 ;Description: Returns the field number of a subscript for the PATIENT object.
+2 ;
+3 NEW FNUM
+4 SET FNUM=$SELECT(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="AG/ALLY":.309,1:"")
+5 IF 'FNUM
SET FNUM=$SELECT(SUB="INELDATE":.152,SUB="INELREA":.307,SUB="INELDEC":.1656,SUB="PID":.363,SUB="EMGRES":.181,1:"")
+6 IF FNUM=""
SET FNUM=$SELECT(SUB="IR":.32103,SUB="RADEXPM":.3212,SUB="APPREQ":1010.159,SUB="APPREQDT":1010.1511,SUB="SPININJ":57.4,SUB="PFSRC":27.03,1:"")
+7 QUIT FNUM
