Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAFCEHU1

VAFCEHU1.m

Go to the documentation of this file. 
  1. VAFCEHU1 ;ALB/JLU,PTD-FILE UTILITIES FOR 391.98 ;11/21/02  12:24
  1.  ;;5.3;Registration;**149,255,307,477,685,1015**;Aug 13, 1993;Build 21
  1.  ;
  1. 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
  1.  ;Date Received^Event date^From whom^patient IEN
  1.  ;  Date Received - This is the date/time that the exception was received
  1.  ;at the facility.  Must be in FM format
  1.  ;  Event date - This is the date/time when the event occurred that caused
  1.  ;this information to be sent.  Must be in FM format
  1.  ;  From whom - This is who sent the information.  This should be in a
  1.  ;free text format.  There is a potential that exception could be coming
  1.  ;from sources other than what is listed in the institution file.
  1.  ;FORMAT of WHOM
  1.  ;  prior to RG*1*8: institution name(sender name)
  1.  ;     after RG*1*8: sending facility: station # -or- station #~domain
  1.  ;
  1.  ;  Patient IEN - The patient file internal entry number.
  1.  ;
  1.  ;         VAFCB - is an array storage structure. It can be either global
  1.  ;or local.  The array should be in the following format.
  1.  ;Ex.   A(file #,field #)=value
  1.  ;      A(file #, field #)=value
  1.  ;
  1.  ;In the case of multiples us the following structure:
  1.  ;Ex.   A(file #,field #,Subfile #, subfield #)=value
  1.  ;***NOTE*** THE SOFTWARE LOGIC TO HANDLE THIS MULTIPLE CASE HAS NOT
  1.  ;BEEN WRITTEN YET.
  1.  ;
  1.  ;**NOTE**
  1.  ;When setting info in the passage array please follow this format for
  1.  ;these exceptions.
  1.  ;-Unspecified or blank data should have no array element or an array
  1.  ;element set to the mumps null.
  1.  ;-If data from a sender can not be resolved then set
  1.  ; $P(array element,U,2)=1
  1.  ;-If you wish to delete what is in the receiving facilities field set
  1.  ;the array element to "@". EX. s X(1)="""@"""
  1.  ;
  1.  ;OUTPUTS
  1.  ; 0^error message - in the case of a failure
  1.  ; 1 - in the case that the entry is added
  1.  ;
  1.  N REC,EVT,WHO,PAT,RESLT,STATUS,LATEST
  1.  K ERR
  1.  S LATEST=""
  1.  I '$D(VAFCA) S ERR="0^Missing date/from parameter" G ADDQ
  1.  I '$D(VAFCB) S ERR="0^Missing array structure" G ADDQ
  1.  S REC=$P(VAFCA,U,1)
  1.  I REC']"" S ERR="0^Missing date of receipt" G ADDQ
  1.  S EVT=$P(VAFCA,U,2)
  1.  I EVT']"" S ERR="0^Missing date of event" G ADDQ
  1.  S WHO=$$WHO^VAFCEHU4($P(VAFCA,"^",3))
  1.  I WHO']"" S ERR="0^Missing who sent the information" G ADDQ
  1.  S PAT=$P(VAFCA,U,4)
  1.  I PAT']"" S ERR="0^Missing patient pointer" G ADDQ
  1.  I '$D(^DPT(PAT,0)) S ERR="0^Patient not defined" G ADDQ
  1.  I '$O(@VAFCB@("")) S ERR="0^Missing array storage structure" G ADDQ
  1.  ;There can be more than one patient update for a given day
  1.  ;resulting from different fields being edited.
  1.  ;I $D(^DGCN(391.98,"AKY",PAT,WHO,EVT)) S ERR="0^Entry already exists." G ADDQ
  1.  ;
  1.  ;update select edited fields and check for any differences
  1.  D EN^VAFCEHU3 I '$G(VAFCQ) S ERR="0^No exception needed" K VAFCQ G ADDQ
  1.  K VAFCQ
  1.  ;check for other entries for this date
  1.  S LATEST=$$CHKDATE(EVT,WHO,PAT)
  1.  ;if other entries than retire them based upon the event date
  1.  S STATUS=$S(LATEST:"ACTION REQUIRED",1:"RETIRED DATA")
  1.  ;
  1.  S (RESLT,RESLT(1))=$$EXCPTN(REC,EVT,WHO,PAT,STATUS)
  1.  I RESLT=-1 S ERR="0^Adding entry failed" G ADDQ
  1.  S RESLT=$$DATA(+RESLT,VAFCB)
  1.  I 'RESLT S ERR="0^Adding element failed"
  1.  ;
  1. ADDQ ;
  1.  I LATEST,'$D(ERR) D RETIRE(EVT,WHO,PAT)
  1.  Q $S($D(ERR):ERR,1:1)
  1.  ;
  1. CHKDATE(EVT,WHO,PAT) ;
  1.  N AFTER
  1.  S AFTER=$O(^DGCN(391.98,"AKY",PAT,WHO,EVT)) ;there is another date after
  1.  Q $S(AFTER:0,1:1)
  1.  ;
  1. RETIRE(EVT,WHO,PAT) ; Retire all previous entries from same site
  1.  N LP,ACTION,EDIT S LP=0
  1.  ;ien of action required
  1.  S ACTION=$O(^DGCN(391.984,"B","ACTION REQUIRED",0))
  1.  Q:'ACTION
  1.  ;looping to get all action required for "from" site
  1.  F  S LP=$O(^DGCN(391.98,"AKY",PAT,WHO,LP)) Q:'LP  D
  1.  .N ENTRY,DATA,XX,ELIEN,NODE
  1.  .S ENTRY=0
  1.  .F  S ENTRY=$O(^DGCN(391.98,"AKY",PAT,WHO,LP,ENTRY)) Q:'ENTRY!(ENTRY=+RESLT(1))  D
  1.  ..S DATA=$G(^DGCN(391.98,ENTRY,0))
  1.  ..;sets the status to retired
  1.  ..I DATA,$P(DATA,U,4)=ACTION D  S XX=$$EDIT(ENTRY,"RETIRED DATA")
  1.  ...;build array of EDITED elements from all entries being retired
  1.  ...S ELIEN=0
  1.  ...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))=""
  1.  ..Q
  1.  ;mark EDITED fields in remaining entry
  1.  Q:'$O(EDIT(0))
  1.  N ELIEN,NODE,P2,P3 S ELIEN=0,DIE="^DGCN(391.99,",DR=".05///1"
  1.  F  S ELIEN=$O(^DGCN(391.99,"B",(+RESLT(1)),ELIEN)) Q:'ELIEN  D
  1.  .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
  1.  ..L +^DGCN(391.99,ELIEN):60 ;**255
  1.  ..S DA=ELIEN D ^DIE
  1.  ..L -^DGCN(391.99,ELIEN) ;**255
  1.  K DA,DIE,DR,EDIT
  1.  Q
  1.  ;
  1. EXCPTN(REC,EVT,WHO,PAT,VAFCA) ;
  1.  N Y
  1.  K DIC,DA,DD,DO
  1.  S DGSENFLG="" ;**255
  1.  S DLAYGO=391.98
  1.  S DIC="^DGCN(391.98,"
  1.  S DIC(0)="LI"
  1.  S X=PAT
  1.  S DIC("DR")=".02///"_REC_";.03///"_EVT_";.04///"_VAFCA_";50///"_WHO
  1.  D FILE^DICN
  1.  K DIC,DLAYGO,X,DGSENFLG ;**255
  1.  Q Y
  1.  ;
  1. DATA(VAFCA,VAFCB) ;
  1.  N ADDED,LP,LP1,VAR
  1.  F LP=0:0 S LP=$O(@VAFCB@(LP)) Q:'LP  DO
  1.  .F LP1=0:0 S LP1=$O(@VAFCB@(LP,LP1)) Q:'LP1  DO
  1.  ..K DIC,DA,DD,DO,VAFCE
  1.  ..S DLAYGO=391.99
  1.  ..S DIC="^DGCN(391.99,"
  1.  ..S DIC(0)="LI" ;**477 added 'I' to suppress incoming filer from generating bulletins
  1.  ..S X=VAFCA
  1.  ..S VAR=@VAFCB@(LP,LP1)
  1.  ..I (@VAFCB@(2,"FLD")[LP1_";"),(VAR]"") S VAFCE=1
  1.  ..S DIC("DR")=".02///"_LP_";.03///"_LP1_";.05///"_$G(VAFCE)_";.06///"_$P(VAR,U,2)_";50////^S X=$P(VAR,U)"
  1.  ..D FILE^DICN
  1.  ..I Y>0 S ADDED=1
  1.  ..Q
  1.  .Q
  1.  Q $S($D(ADDED):1,1:0)
  1.  ;
  1. CHK(A) ;
  1.  ;INPUT - A This parameter contains a piece string of 3 elements
  1.  ;      patient dfn^event date/time^from whom
  1.  ;These are the key element to finding the entry in the patient data 
  1.  ;exception file.
  1.  ;
  1.  ;Patient DFN is the internal entry number of the patient in the patient
  1.  ;file.
  1.  ;
  1.  ;event date/time is the date/time the event took place at the facility
  1.  ;that sent the data.  This date must be in FM format.
  1.  ;
  1.  ;from whom is who sent this information to this medical center.
  1.  ;
  1.  ;OUTPUT
  1.  ; ZERO(0) if nothing found
  1.  ; ZERO(0)^error description if an error found
  1.  ; IEN of the entry in the patient data exception file if found
  1.  ;
  1.  N FOUND,PAT,EVT,WHO
  1.  S FOUND=0
  1.  I '$D(A) S FOUND="0^Input parameter missing." G CHKQ
  1.  S PAT=$P(A,U,1)
  1.  I PAT']"" S FOUND="0^No patient DFN defined." G CHKQ
  1.  I '$D(^DPT(PAT,0)) S FOUND="0^No patient with this DFN." G CHKQ
  1.  S EVT=$P(A,U,2)
  1.  I EVT']"" S FOUND="0^Date of event not defined." G CHKQ
  1.  S WHO=$$WHO^VAFCEHU4($P(A,U,3))
  1.  I WHO']"" S FOUND="0^Who sent the information is not defined." G CHKQ
  1.  ;
  1.  I $D(^DGCN(391.98,"AKY",PAT,WHO,EVT)) DO
  1.  .S FOUND=$O(^(EVT,"")) ;naked on the ^dgcn aky cross ref.
  1.  .I '$D(^DGCN(391.98,FOUND,0)) S FOUND=0
  1.  .Q
  1.  ;
  1. CHKQ Q FOUND
  1.  ;
  1. DELEXCPT(IEN) ;
  1.  ;This entry point deletes the entire exception from the file 391.98 
  1.  ;and 391.99
  1.  ;INPUTS
  1.  ;IEN is the IEN of the entry in 391.98 it can be obtained from the call
  1.  ; to the CHK line tag.
  1.  ;
  1.  ;OUTPUT
  1.  ;ZERO(0) - if a problem or no deletion
  1.  ;ONE(1) - if deletion occurred
  1.  ;
  1.  I '$D(IEN) S ERR="0^Input parameter missing." G DELQ
  1.  I IEN']"" S ERR="0^Input parameter undefined." G DELQ
  1.  I '$D(^DGCN(391.98,IEN,0)) S ERR="0^Exception data missing." G DELQ
  1.  D DELDATA(IEN,.ERR)
  1.  ;
  1.  S DIK="^DGCN(391.98,"
  1.  S DA=IEN
  1.  D ^DIK
  1.  K DIK,DA
  1.  S ERR=1
  1.  ;
  1. DELQ Q ERR
  1.  ;
  1. DELDATA(IEN,ERR) ;
  1.  N LP
  1.  F LP=0:0 S LP=$O(^DGCN(391.99,"B",IEN,LP)) Q:'LP  DO
  1.  .I '$D(^DGCN(391.99,LP,0)) Q
  1.  .S DIK="^DGCN(391.99,"
  1.  .S DA=LP
  1.  .D ^DIK
  1.  .K DA,DIK
  1.  .S ERR=1
  1.  .Q
  1.  Q
  1.  ;
  1. EDIT(IEN,STAT) ;
  1.  ;This entry point allows the editing of the status of an exception.
  1.  ;INPUT
  1.  ;IEN - the ien for an entry from 391.98
  1.  ;STAT - the new status.
  1.  ;
  1.  ;OUTPUTS
  1.  ;ZERO(0)^ description if an error
  1.  ;1 if changed
  1.  N ERR
  1.  ;
  1.  I '$D(IEN) S ERR="0^IEN not defined." G EDITQ
  1.  I IEN']"" S ERR="0^IEN is null." G EDITQ
  1.  I '$D(STAT) S ERR="0^Status is not defined." G EDITQ
  1.  I STAT']"" S ERR="0^Status is null." G EDITQ
  1.  I '$D(^DGCN(391.98,IEN,0)) S ERR="0^No entry for the IEN." G EDITQ
  1.  ;
  1.  N DIE,DA,DR
  1.  S DIE="^DGCN(391.98,"
  1.  S DA=IEN
  1.  S DR=".04///"_STAT
  1.  D ^DIE
  1.  S ERR=1
  1.  ;
  1. EDITQ Q ERR
  1.  ;
  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 
  1.  ;reviewed, data rejected, merge complete or retired data can not be
  1.  ;set to being reviewed and thus accessed.
  1.  ;
  1.  ;INPUT - IEN the ien of the exception
  1.  ;
  1.  ;OUTPUT - 1 if the exception was able to be locked/ status turned to
  1.  ;           being reviewed.
  1.  ;         0^description if the exception was not able to be "locked"
  1.  ;
  1.  N ERR,STAT,DATA
  1.  I '$D(IEN) S ERR="0^No input." G LCKQ
  1.  I IEN']"" S ERR="0^Null input." G LCKQ
  1.  L +^DGCN(391.98,IEN):0 I '$T S ERR="0^Exception is currently locked." G LCKQ ;**255
  1.  S DATA=$G(^DGCN(391.98,IEN,0))
  1.  I DATA="" S ERR="0^Exception not found." G LCKQ
  1.  S STAT=$P(DATA,U,4)
  1.  I STAT']"" S ERR="0^Status not defined." G LCKQ
  1.  S STAT=$G(^DGCN(391.984,STAT,0))
  1.  I STAT="" S ERR="0^Status not found." G LCKQ
  1.  I $P(STAT,U,2)'="AR",($P(STAT,U,2)'="DE") S ERR="0^"_$P(STAT,U,1) G LCKQ
  1.  I $$EDIT(IEN,"BR") S ERR="1^OK"
  1.  E  S ERR="0^Could not change status."
  1.  ;
  1. LCKQ Q ERR