VAFCEHU1 ;ALB/JLU,PTD-FILE UTILITIES FOR 391.98 ;11/21/02 12:24
;;5.3;Registration;**149,255,307,477,685**;Aug 13, 1993
;
ADD(VAFCA,VAFCB) ;Main entry point to add an entry to 391.98
;INPUTS VAFCA - This parameter contains a piece string of 4 elements
;Date Received^Event date^From whom^patient IEN
; Date Received - This is the date/time that the exception was received
;at the facility. Must be in FM format
; Event date - This is the date/time when the event occurred that caused
;this information to be sent. Must be in FM format
; From whom - This is who sent the information. This should be in a
;free text format. There is a potential that exception could be coming
;from sources other than what is listed in the institution file.
;FORMAT of WHOM
; prior to RG*1*8: institution name(sender name)
; after RG*1*8: sending facility: station # -or- station #~domain
;
; Patient IEN - The patient file internal entry number.
;
; VAFCB - is an array storage structure. It can be either global
;or local. The array should be in the following format.
;Ex. A(file #,field #)=value
; A(file #, field #)=value
;
;In the case of multiples us the following structure:
;Ex. A(file #,field #,Subfile #, subfield #)=value
;***NOTE*** THE SOFTWARE LOGIC TO HANDLE THIS MULTIPLE CASE HAS NOT
;BEEN WRITTEN YET.
;
;**NOTE**
;When setting info in the passage array please follow this format for
;these exceptions.
;-Unspecified or blank data should have no array element or an array
;element set to the mumps null.
;-If data from a sender can not be resolved then set
; $P(array element,U,2)=1
;-If you wish to delete what is in the receiving facilities field set
;the array element to "@". EX. s X(1)="""@"""
;
;OUTPUTS
; 0^error message - in the case of a failure
; 1 - in the case that the entry is added
;
N REC,EVT,WHO,PAT,RESLT,STATUS,LATEST
K ERR
S LATEST=""
I '$D(VAFCA) S ERR="0^Missing date/from parameter" G ADDQ
I '$D(VAFCB) S ERR="0^Missing array structure" G ADDQ
S REC=$P(VAFCA,U,1)
I REC']"" S ERR="0^Missing date of receipt" G ADDQ
S EVT=$P(VAFCA,U,2)
I EVT']"" S ERR="0^Missing date of event" G ADDQ
S WHO=$$WHO^VAFCEHU4($P(VAFCA,"^",3))
I WHO']"" S ERR="0^Missing who sent the information" G ADDQ
S PAT=$P(VAFCA,U,4)
I PAT']"" S ERR="0^Missing patient pointer" G ADDQ
I '$D(^DPT(PAT,0)) S ERR="0^Patient not defined" G ADDQ
I '$O(@VAFCB@("")) S ERR="0^Missing array storage structure" G ADDQ
;There can be more than one patient update for a given day
;resulting from different fields being edited.
;I $D(^DGCN(391.98,"AKY",PAT,WHO,EVT)) S ERR="0^Entry already exists." G ADDQ
;
;update select edited fields and check for any differences
D EN^VAFCEHU3 I '$G(VAFCQ) S ERR="0^No exception needed" K VAFCQ G ADDQ
K VAFCQ
;check for other entries for this date
S LATEST=$$CHKDATE(EVT,WHO,PAT)
;if other entries than retire them based upon the event date
S STATUS=$S(LATEST:"ACTION REQUIRED",1:"RETIRED DATA")
;
S (RESLT,RESLT(1))=$$EXCPTN(REC,EVT,WHO,PAT,STATUS)
I RESLT=-1 S ERR="0^Adding entry failed" G ADDQ
S RESLT=$$DATA(+RESLT,VAFCB)
I 'RESLT S ERR="0^Adding element failed"
;
ADDQ ;
I LATEST,'$D(ERR) D RETIRE(EVT,WHO,PAT)
Q $S($D(ERR):ERR,1:1)
;
CHKDATE(EVT,WHO,PAT) ;
N AFTER
S AFTER=$O(^DGCN(391.98,"AKY",PAT,WHO,EVT)) ;there is another date after
Q $S(AFTER:0,1:1)
;
RETIRE(EVT,WHO,PAT) ; Retire all previous entries from same site
N LP,ACTION,EDIT S LP=0
;ien of action required
S ACTION=$O(^DGCN(391.984,"B","ACTION REQUIRED",0))
Q:'ACTION
;looping to get all action required for "from" site
F S LP=$O(^DGCN(391.98,"AKY",PAT,WHO,LP)) Q:'LP D
.N ENTRY,DATA,XX,ELIEN,NODE
.S ENTRY=0
.F S ENTRY=$O(^DGCN(391.98,"AKY",PAT,WHO,LP,ENTRY)) Q:'ENTRY!(ENTRY=+RESLT(1)) D
..S DATA=$G(^DGCN(391.98,ENTRY,0))
..;sets the status to retired
..I DATA,$P(DATA,U,4)=ACTION D S XX=$$EDIT(ENTRY,"RETIRED DATA")
...;build array of EDITED elements from all entries being retired
...S ELIEN=0
...F S ELIEN=$O(^DGCN(391.99,"B",ENTRY,ELIEN)) Q:'ELIEN S NODE=$G(^DGCN(391.99,ELIEN,0)) I NODE,$P(NODE,U,5)=1 S EDIT($P(NODE,U,2),$P(NODE,U,3))=""
..Q
;mark EDITED fields in remaining entry
Q:'$O(EDIT(0))
N ELIEN,NODE,P2,P3 S ELIEN=0,DIE="^DGCN(391.99,",DR=".05///1"
F S ELIEN=$O(^DGCN(391.99,"B",(+RESLT(1)),ELIEN)) Q:'ELIEN D
.S NODE=$G(^DGCN(391.99,ELIEN,0)),(P2,P3)="" I NODE S P2=$P(NODE,U,2),P3=$P(NODE,U,3) I $D(EDIT(P2,P3)) D
..L +^DGCN(391.99,ELIEN):60 ;**255
..S DA=ELIEN D ^DIE
..L -^DGCN(391.99,ELIEN) ;**255
K DA,DIE,DR,EDIT
Q
;
EXCPTN(REC,EVT,WHO,PAT,VAFCA) ;
N Y
K DIC,DA,DD,DO
S DGSENFLG="" ;**255
S DLAYGO=391.98
S DIC="^DGCN(391.98,"
S DIC(0)="LI"
S X=PAT
S DIC("DR")=".02///"_REC_";.03///"_EVT_";.04///"_VAFCA_";50///"_WHO
D FILE^DICN
K DIC,DLAYGO,X,DGSENFLG ;**255
Q Y
;
DATA(VAFCA,VAFCB) ;
N ADDED,LP,LP1,VAR
F LP=0:0 S LP=$O(@VAFCB@(LP)) Q:'LP DO
.F LP1=0:0 S LP1=$O(@VAFCB@(LP,LP1)) Q:'LP1 DO
..K DIC,DA,DD,DO,VAFCE
..S DLAYGO=391.99
..S DIC="^DGCN(391.99,"
..S DIC(0)="LI" ;**477 added 'I' to suppress incoming filer from generating bulletins
..S X=VAFCA
..S VAR=@VAFCB@(LP,LP1)
..I (@VAFCB@(2,"FLD")[LP1_";"),(VAR]"") S VAFCE=1
..S DIC("DR")=".02///"_LP_";.03///"_LP1_";.05///"_$G(VAFCE)_";.06///"_$P(VAR,U,2)_";50////^S X=$P(VAR,U)"
..D FILE^DICN
..I Y>0 S ADDED=1
..Q
.Q
Q $S($D(ADDED):1,1:0)
;
CHK(A) ;
;INPUT - A This parameter contains a piece string of 3 elements
; patient dfn^event date/time^from whom
;These are the key element to finding the entry in the patient data
;exception file.
;
;Patient DFN is the internal entry number of the patient in the patient
;file.
;
;event date/time is the date/time the event took place at the facility
;that sent the data. This date must be in FM format.
;
;from whom is who sent this information to this medical center.
;
;OUTPUT
; ZERO(0) if nothing found
; ZERO(0)^error description if an error found
; IEN of the entry in the patient data exception file if found
;
N FOUND,PAT,EVT,WHO
S FOUND=0
I '$D(A) S FOUND="0^Input parameter missing." G CHKQ
S PAT=$P(A,U,1)
I PAT']"" S FOUND="0^No patient DFN defined." G CHKQ
I '$D(^DPT(PAT,0)) S FOUND="0^No patient with this DFN." G CHKQ
S EVT=$P(A,U,2)
I EVT']"" S FOUND="0^Date of event not defined." G CHKQ
S WHO=$$WHO^VAFCEHU4($P(A,U,3))
I WHO']"" S FOUND="0^Who sent the information is not defined." G CHKQ
;
I $D(^DGCN(391.98,"AKY",PAT,WHO,EVT)) DO
.S FOUND=$O(^(EVT,"")) ;naked on the ^dgcn aky cross ref.
.I '$D(^DGCN(391.98,FOUND,0)) S FOUND=0
.Q
;
CHKQ Q FOUND
;
DELEXCPT(IEN) ;
;This entry point deletes the entire exception from the file 391.98
;and 391.99
;INPUTS
;IEN is the IEN of the entry in 391.98 it can be obtained from the call
; to the CHK line tag.
;
;OUTPUT
;ZERO(0) - if a problem or no deletion
;ONE(1) - if deletion occurred
;
I '$D(IEN) S ERR="0^Input parameter missing." G DELQ
I IEN']"" S ERR="0^Input parameter undefined." G DELQ
I '$D(^DGCN(391.98,IEN,0)) S ERR="0^Exception data missing." G DELQ
D DELDATA(IEN,.ERR)
;
S DIK="^DGCN(391.98,"
S DA=IEN
D ^DIK
K DIK,DA
S ERR=1
;
DELQ Q ERR
;
DELDATA(IEN,ERR) ;
N LP
F LP=0:0 S LP=$O(^DGCN(391.99,"B",IEN,LP)) Q:'LP DO
.I '$D(^DGCN(391.99,LP,0)) Q
.S DIK="^DGCN(391.99,"
.S DA=LP
.D ^DIK
.K DA,DIK
.S ERR=1
.Q
Q
;
EDIT(IEN,STAT) ;
;This entry point allows the editing of the status of an exception.
;INPUT
;IEN - the ien for an entry from 391.98
;STAT - the new status.
;
;OUTPUTS
;ZERO(0)^ description if an error
;1 if changed
N ERR
;
I '$D(IEN) S ERR="0^IEN not defined." G EDITQ
I IEN']"" S ERR="0^IEN is null." G EDITQ
I '$D(STAT) S ERR="0^Status is not defined." G EDITQ
I STAT']"" S ERR="0^Status is null." G EDITQ
I '$D(^DGCN(391.98,IEN,0)) S ERR="0^No entry for the IEN." G EDITQ
;
N DIE,DA,DR
S DIE="^DGCN(391.98,"
S DA=IEN
S DR=".04///"_STAT
D ^DIE
S ERR=1
;
EDITQ Q ERR
;
LOCK(IEN) ;this function call will check the status of the exception and
;set it to being reviewed if it is able. Exceptions that are being
;reviewed, data rejected, merge complete or retired data can not be
;set to being reviewed and thus accessed.
;
;INPUT - IEN the ien of the exception
;
;OUTPUT - 1 if the exception was able to be locked/ status turned to
; being reviewed.
; 0^description if the exception was not able to be "locked"
;
N ERR,STAT,DATA
I '$D(IEN) S ERR="0^No input." G LCKQ
I IEN']"" S ERR="0^Null input." G LCKQ
L +^DGCN(391.98,IEN):0 I '$T S ERR="0^Exception is currently locked." G LCKQ ;**255
S DATA=$G(^DGCN(391.98,IEN,0))
I DATA="" S ERR="0^Exception not found." G LCKQ
S STAT=$P(DATA,U,4)
I STAT']"" S ERR="0^Status not defined." G LCKQ
S STAT=$G(^DGCN(391.984,STAT,0))
I STAT="" S ERR="0^Status not found." G LCKQ
I $P(STAT,U,2)'="AR",($P(STAT,U,2)'="DE") S ERR="0^"_$P(STAT,U,1) G LCKQ
I $$EDIT(IEN,"BR") S ERR="1^OK"
E S ERR="0^Could not change status."
;
LCKQ Q ERR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCEHU1 9263 printed Sep 23, 2025@20:37:33 Page 2
VAFCEHU1 ;ALB/JLU,PTD-FILE UTILITIES FOR 391.98 ;11/21/02 12:24
+1 ;;5.3;Registration;**149,255,307,477,685**;Aug 13, 1993
+2 ;
ADD(VAFCA,VAFCB) ;Main entry point to add an entry to 391.98
+1 ;INPUTS VAFCA - This parameter contains a piece string of 4 elements
+2 ;Date Received^Event date^From whom^patient IEN
+3 ; Date Received - This is the date/time that the exception was received
+4 ;at the facility. Must be in FM format
+5 ; Event date - This is the date/time when the event occurred that caused
+6 ;this information to be sent. Must be in FM format
+7 ; From whom - This is who sent the information. This should be in a
+8 ;free text format. There is a potential that exception could be coming
+9 ;from sources other than what is listed in the institution file.
+10 ;FORMAT of WHOM
+11 ; prior to RG*1*8: institution name(sender name)
+12 ; after RG*1*8: sending facility: station # -or- station #~domain
+13 ;
+14 ; Patient IEN - The patient file internal entry number.
+15 ;
+16 ; VAFCB - is an array storage structure. It can be either global
+17 ;or local. The array should be in the following format.
+18 ;Ex. A(file #,field #)=value
+19 ; A(file #, field #)=value
+20 ;
+21 ;In the case of multiples us the following structure:
+22 ;Ex. A(file #,field #,Subfile #, subfield #)=value
+23 ;***NOTE*** THE SOFTWARE LOGIC TO HANDLE THIS MULTIPLE CASE HAS NOT
+24 ;BEEN WRITTEN YET.
+25 ;
+26 ;**NOTE**
+27 ;When setting info in the passage array please follow this format for
+28 ;these exceptions.
+29 ;-Unspecified or blank data should have no array element or an array
+30 ;element set to the mumps null.
+31 ;-If data from a sender can not be resolved then set
+32 ; $P(array element,U,2)=1
+33 ;-If you wish to delete what is in the receiving facilities field set
+34 ;the array element to "@". EX. s X(1)="""@"""
+35 ;
+36 ;OUTPUTS
+37 ; 0^error message - in the case of a failure
+38 ; 1 - in the case that the entry is added
+39 ;
+40 NEW REC,EVT,WHO,PAT,RESLT,STATUS,LATEST
+41 KILL ERR
+42 SET LATEST=""
+43 IF '$DATA(VAFCA)
SET ERR="0^Missing date/from parameter"
GOTO ADDQ
+44 IF '$DATA(VAFCB)
SET ERR="0^Missing array structure"
GOTO ADDQ
+45 SET REC=$PIECE(VAFCA,U,1)
+46 IF REC']""
SET ERR="0^Missing date of receipt"
GOTO ADDQ
+47 SET EVT=$PIECE(VAFCA,U,2)
+48 IF EVT']""
SET ERR="0^Missing date of event"
GOTO ADDQ
+49 SET WHO=$$WHO^VAFCEHU4($PIECE(VAFCA,"^",3))
+50 IF WHO']""
SET ERR="0^Missing who sent the information"
GOTO ADDQ
+51 SET PAT=$PIECE(VAFCA,U,4)
+52 IF PAT']""
SET ERR="0^Missing patient pointer"
GOTO ADDQ
+53 IF '$DATA(^DPT(PAT,0))
SET ERR="0^Patient not defined"
GOTO ADDQ
+54 IF '$ORDER(@VAFCB@(""))
SET ERR="0^Missing array storage structure"
GOTO ADDQ
+55 ;There can be more than one patient update for a given day
+56 ;resulting from different fields being edited.
+57 ;I $D(^DGCN(391.98,"AKY",PAT,WHO,EVT)) S ERR="0^Entry already exists." G ADDQ
+58 ;
+59 ;update select edited fields and check for any differences
+60 DO EN^VAFCEHU3
IF '$GET(VAFCQ)
SET ERR="0^No exception needed"
KILL VAFCQ
GOTO ADDQ
+61 KILL VAFCQ
+62 ;check for other entries for this date
+63 SET LATEST=$$CHKDATE(EVT,WHO,PAT)
+64 ;if other entries than retire them based upon the event date
+65 SET STATUS=$SELECT(LATEST:"ACTION REQUIRED",1:"RETIRED DATA")
+66 ;
+67 SET (RESLT,RESLT(1))=$$EXCPTN(REC,EVT,WHO,PAT,STATUS)
+68 IF RESLT=-1
SET ERR="0^Adding entry failed"
GOTO ADDQ
+69 SET RESLT=$$DATA(+RESLT,VAFCB)
+70 IF 'RESLT
SET ERR="0^Adding element failed"
+71 ;
ADDQ ;
+1 IF LATEST
IF '$DATA(ERR)
DO RETIRE(EVT,WHO,PAT)
+2 QUIT $SELECT($DATA(ERR):ERR,1:1)
+3 ;
CHKDATE(EVT,WHO,PAT) ;
+1 NEW AFTER
+2 ;there is another date after
SET AFTER=$ORDER(^DGCN(391.98,"AKY",PAT,WHO,EVT))
+3 QUIT $SELECT(AFTER:0,1:1)
+4 ;
RETIRE(EVT,WHO,PAT) ; Retire all previous entries from same site
+1 NEW LP,ACTION,EDIT
SET LP=0
+2 ;ien of action required
+3 SET ACTION=$ORDER(^DGCN(391.984,"B","ACTION REQUIRED",0))
+4 if 'ACTION
QUIT
+5 ;looping to get all action required for "from" site
+6 FOR
SET LP=$ORDER(^DGCN(391.98,"AKY",PAT,WHO,LP))
if 'LP
QUIT
Begin DoDot:1
+7 NEW ENTRY,DATA,XX,ELIEN,NODE
+8 SET ENTRY=0
+9 FOR
SET ENTRY=$ORDER(^DGCN(391.98,"AKY",PAT,WHO,LP,ENTRY))
if 'ENTRY!(ENTRY=+RESLT(1))
QUIT
Begin DoDot:2
+10 SET DATA=$GET(^DGCN(391.98,ENTRY,0))
+11 ;sets the status to retired
+12 IF DATA
IF $PIECE(DATA,U,4)=ACTION
Begin DoDot:3
+13 ;build array of EDITED elements from all entries being retired
+14 SET ELIEN=0
+15 FOR
SET ELIEN=$ORDER(^DGCN(391.99,"B",ENTRY,ELIEN))
if 'ELIEN
QUIT
SET NODE=$GET(^DGCN(391.99,ELIEN,0))
IF NODE
IF $PIECE(NODE,U,5)=1
SET EDIT($PIECE(NODE,U,2),$PIECE(NODE,U,3))=""
End DoDot:3
SET XX=$$EDIT(ENTRY,"RETIRED DATA")
+16 QUIT
End DoDot:2
End DoDot:1
+17 ;mark EDITED fields in remaining entry
+18 if '$ORDER(EDIT(0))
QUIT
+19 NEW ELIEN,NODE,P2,P3
SET ELIEN=0
SET DIE="^DGCN(391.99,"
SET DR=".05///1"
+20 FOR
SET ELIEN=$ORDER(^DGCN(391.99,"B",(+RESLT(1)),ELIEN))
if 'ELIEN
QUIT
Begin DoDot:1
+21 SET NODE=$GET(^DGCN(391.99,ELIEN,0))
SET (P2,P3)=""
IF NODE
SET P2=$PIECE(NODE,U,2)
SET P3=$PIECE(NODE,U,3)
IF $DATA(EDIT(P2,P3))
Begin DoDot:2
+22 ;**255
LOCK +^DGCN(391.99,ELIEN):60
+23 SET DA=ELIEN
DO ^DIE
+24 ;**255
LOCK -^DGCN(391.99,ELIEN)
End DoDot:2
End DoDot:1
+25 KILL DA,DIE,DR,EDIT
+26 QUIT
+27 ;
EXCPTN(REC,EVT,WHO,PAT,VAFCA) ;
+1 NEW Y
+2 KILL DIC,DA,DD,DO
+3 ;**255
SET DGSENFLG=""
+4 SET DLAYGO=391.98
+5 SET DIC="^DGCN(391.98,"
+6 SET DIC(0)="LI"
+7 SET X=PAT
+8 SET DIC("DR")=".02///"_REC_";.03///"_EVT_";.04///"_VAFCA_";50///"_WHO
+9 DO FILE^DICN
+10 ;**255
KILL DIC,DLAYGO,X,DGSENFLG
+11 QUIT Y
+12 ;
DATA(VAFCA,VAFCB) ;
+1 NEW ADDED,LP,LP1,VAR
+2 FOR LP=0:0
SET LP=$ORDER(@VAFCB@(LP))
if 'LP
QUIT
Begin DoDot:1
+3 FOR LP1=0:0
SET LP1=$ORDER(@VAFCB@(LP,LP1))
if 'LP1
QUIT
Begin DoDot:2
+4 KILL DIC,DA,DD,DO,VAFCE
+5 SET DLAYGO=391.99
+6 SET DIC="^DGCN(391.99,"
+7 ;**477 added 'I' to suppress incoming filer from generating bulletins
SET DIC(0)="LI"
+8 SET X=VAFCA
+9 SET VAR=@VAFCB@(LP,LP1)
+10 IF (@VAFCB@(2,"FLD")[LP1_";")
IF (VAR]"")
SET VAFCE=1
+11 SET DIC("DR")=".02///"_LP_";.03///"_LP1_";.05///"_$GET(VAFCE)_";.06///"_$PIECE(VAR,U,2)_";50////^S X=$P(VAR,U)"
+12 DO FILE^DICN
+13 IF Y>0
SET ADDED=1
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 QUIT $SELECT($DATA(ADDED):1,1:0)
+17 ;
CHK(A) ;
+1 ;INPUT - A This parameter contains a piece string of 3 elements
+2 ; patient dfn^event date/time^from whom
+3 ;These are the key element to finding the entry in the patient data
+4 ;exception file.
+5 ;
+6 ;Patient DFN is the internal entry number of the patient in the patient
+7 ;file.
+8 ;
+9 ;event date/time is the date/time the event took place at the facility
+10 ;that sent the data. This date must be in FM format.
+11 ;
+12 ;from whom is who sent this information to this medical center.
+13 ;
+14 ;OUTPUT
+15 ; ZERO(0) if nothing found
+16 ; ZERO(0)^error description if an error found
+17 ; IEN of the entry in the patient data exception file if found
+18 ;
+19 NEW FOUND,PAT,EVT,WHO
+20 SET FOUND=0
+21 IF '$DATA(A)
SET FOUND="0^Input parameter missing."
GOTO CHKQ
+22 SET PAT=$PIECE(A,U,1)
+23 IF PAT']""
SET FOUND="0^No patient DFN defined."
GOTO CHKQ
+24 IF '$DATA(^DPT(PAT,0))
SET FOUND="0^No patient with this DFN."
GOTO CHKQ
+25 SET EVT=$PIECE(A,U,2)
+26 IF EVT']""
SET FOUND="0^Date of event not defined."
GOTO CHKQ
+27 SET WHO=$$WHO^VAFCEHU4($PIECE(A,U,3))
+28 IF WHO']""
SET FOUND="0^Who sent the information is not defined."
GOTO CHKQ
+29 ;
+30 IF $DATA(^DGCN(391.98,"AKY",PAT,WHO,EVT))
Begin DoDot:1
+31 ;naked on the ^dgcn aky cross ref.
SET FOUND=$ORDER(^(EVT,""))
+32 IF '$DATA(^DGCN(391.98,FOUND,0))
SET FOUND=0
+33 QUIT
End DoDot:1
+34 ;
CHKQ QUIT FOUND
+1 ;
DELEXCPT(IEN) ;
+1 ;This entry point deletes the entire exception from the file 391.98
+2 ;and 391.99
+3 ;INPUTS
+4 ;IEN is the IEN of the entry in 391.98 it can be obtained from the call
+5 ; to the CHK line tag.
+6 ;
+7 ;OUTPUT
+8 ;ZERO(0) - if a problem or no deletion
+9 ;ONE(1) - if deletion occurred
+10 ;
+11 IF '$DATA(IEN)
SET ERR="0^Input parameter missing."
GOTO DELQ
+12 IF IEN']""
SET ERR="0^Input parameter undefined."
GOTO DELQ
+13 IF '$DATA(^DGCN(391.98,IEN,0))
SET ERR="0^Exception data missing."
GOTO DELQ
+14 DO DELDATA(IEN,.ERR)
+15 ;
+16 SET DIK="^DGCN(391.98,"
+17 SET DA=IEN
+18 DO ^DIK
+19 KILL DIK,DA
+20 SET ERR=1
+21 ;
DELQ QUIT ERR
+1 ;
DELDATA(IEN,ERR) ;
+1 NEW LP
+2 FOR LP=0:0
SET LP=$ORDER(^DGCN(391.99,"B",IEN,LP))
if 'LP
QUIT
Begin DoDot:1
+3 IF '$DATA(^DGCN(391.99,LP,0))
QUIT
+4 SET DIK="^DGCN(391.99,"
+5 SET DA=LP
+6 DO ^DIK
+7 KILL DA,DIK
+8 SET ERR=1
+9 QUIT
End DoDot:1
+10 QUIT
+11 ;
EDIT(IEN,STAT) ;
+1 ;This entry point allows the editing of the status of an exception.
+2 ;INPUT
+3 ;IEN - the ien for an entry from 391.98
+4 ;STAT - the new status.
+5 ;
+6 ;OUTPUTS
+7 ;ZERO(0)^ description if an error
+8 ;1 if changed
+9 NEW ERR
+10 ;
+11 IF '$DATA(IEN)
SET ERR="0^IEN not defined."
GOTO EDITQ
+12 IF IEN']""
SET ERR="0^IEN is null."
GOTO EDITQ
+13 IF '$DATA(STAT)
SET ERR="0^Status is not defined."
GOTO EDITQ
+14 IF STAT']""
SET ERR="0^Status is null."
GOTO EDITQ
+15 IF '$DATA(^DGCN(391.98,IEN,0))
SET ERR="0^No entry for the IEN."
GOTO EDITQ
+16 ;
+17 NEW DIE,DA,DR
+18 SET DIE="^DGCN(391.98,"
+19 SET DA=IEN
+20 SET DR=".04///"_STAT
+21 DO ^DIE
+22 SET ERR=1
+23 ;
EDITQ QUIT ERR
+1 ;
LOCK(IEN) ;this function call will check the status of the exception and
+1 ;set it to being reviewed if it is able. Exceptions that are being
+2 ;reviewed, data rejected, merge complete or retired data can not be
+3 ;set to being reviewed and thus accessed.
+4 ;
+5 ;INPUT - IEN the ien of the exception
+6 ;
+7 ;OUTPUT - 1 if the exception was able to be locked/ status turned to
+8 ; being reviewed.
+9 ; 0^description if the exception was not able to be "locked"
+10 ;
+11 NEW ERR,STAT,DATA
+12 IF '$DATA(IEN)
SET ERR="0^No input."
GOTO LCKQ
+13 IF IEN']""
SET ERR="0^Null input."
GOTO LCKQ
+14 ;**255
LOCK +^DGCN(391.98,IEN):0
IF '$TEST
SET ERR="0^Exception is currently locked."
GOTO LCKQ
+15 SET DATA=$GET(^DGCN(391.98,IEN,0))
+16 IF DATA=""
SET ERR="0^Exception not found."
GOTO LCKQ
+17 SET STAT=$PIECE(DATA,U,4)
+18 IF STAT']""
SET ERR="0^Status not defined."
GOTO LCKQ
+19 SET STAT=$GET(^DGCN(391.984,STAT,0))
+20 IF STAT=""
SET ERR="0^Status not found."
GOTO LCKQ
+21 IF $PIECE(STAT,U,2)'="AR"
IF ($PIECE(STAT,U,2)'="DE")
SET ERR="0^"_$PIECE(STAT,U,1)
GOTO LCKQ
+22 IF $$EDIT(IEN,"BR")
SET ERR="1^OK"
+23 IF '$TEST
SET ERR="0^Could not change status."
+24 ;
LCKQ QUIT ERR
