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

AQALNK1.m

Go to the documentation of this file. 
  1. AQALNK1 ; IHS/ORDC/LJF - EDIT/DELETE AUTO OCCURRENCES ;
  1.  ;;1;QI LINKAGES-RPMS;;AUG 15, 1994
  1.  ;
  1.  ;This rtn is available to RPMS packages that wish to automatically
  1.  ;edit or delete occurrence entries.  The input variables are:
  1.  ;
  1.  ; AQALNK("OCC")=ifn of occurrence to modify or delete
  1.  ; AQALNK("PAT")=patient's DFN (required)
  1.  ; AQALNK("IND")=internal entry # for indicator (required)
  1.  ; AQALNK("DATE")=occurrence date (required)
  1.  ; AQALNK("VSIT")=visit internal number (optional but recommended)
  1.  ; AQALNK("HSV")=hospital service for visit (required but can be null)
  1.  ; AQALNK("WARD")=ward moved into fro admits, out of for others
  1.  ; AQALNK("FAC")=facility internal number (required if no visit #)
  1.  ; AQALNK("DUP OK")=if defined, allows adding duplicate occurrence
  1.  ; AQALNK("BUL")=name of error bulletin
  1.  ; AQALXTR array for data to be stuffed into case summary field
  1.  ;
  1.  ;The output variables will include those listed above AND 
  1.  ; AQALIFN=occurrence internal entry number   OR
  1.  ; AQALNKF("NO GO")=set if occurrence not created PLUS
  1.  ;  AQALNKF("PAT")=if set, describes patient error
  1.  ;  AQALNKF("IND")=if set, describes indicator error
  1.  ;  AQALNKF("DATE")=if set, describes occurrence date error
  1.  ;  AQALNKF("VSIT")=if set, describes visit error
  1.  ;  AQALNKF("FAC")=if set, describes facility error
  1.  ;
  1.  ;The calling routine will be responsible for killing the variables
  1.  ;described above.  This routine will kill all other AQA variables used.
  1.  ;The published entry is EDIT^AQALNK1.
  1.  ;
  1. EDIT ;PEP; PUBLIC ENTRY POINT to create occurrences
  1.  ; >>> check input variables
  1.  K AQALNKF,AQALIFN
  1.  F I="OCC","PAT","IND","DATE","FAC" D
  1.  .I '$D(AQALNK(I)) S AQALNKF(I)="Variable AQALNK("_I_") is missing" Q
  1.  .I AQALNK(I)="" S AQALNKF(I)="Variable set but null"
  1.  I $D(AQALNKF) G EXIT ;quit if error flags set
  1.  ;
  1.  D VARCHECK^AQALNK ;check validity of input variables
  1.  I $D(AQALNKF) G EXIT ;quit if error flags set
  1.  I '$D(AQALNK("VSIT")) S AQALNK("VSIT")=""
  1.  ;
  1.  ;
  1. DIE ; >>> set variables and call file^dicn
  1.  S AQALPAT=AQALNK("PAT"),AQALDATE=AQALNK("DATE"),AQALIND=AQALNK("IND")
  1.  S AQAODATE=AQALDATE,AQAOPAT=AQALPAT,AQAOIND=AQALIND
  1.  S AQALCID=$P($G(^AQAOC(AQALNK("OCC"),0)),U) ; occ id number
  1.  I '$D(AQALCID) S AQALNKF("NO GO")="Occurrence in xref but not in file" G EXIT
  1.  ;
  1.  K DIE S DIE="^AQAOC(",(AQALIFN,DA)=AQALNK("OCC")
  1.  S DR=".02////"_AQALPAT_";.03////"_AQALNK("VSIT")_";.04////"_AQALDATE_";.06////"_AQALNK("WARD")_";.07////"_AQALNK("HSV")_";.08////"_AQALIND_";.09////"_AQALNK("FAC")_";.011////1;.11////0"
  1.  L +(^AQAOC(AQALNK("OCC"))):1 I '$T D  G EXIT
  1.  .S AQALNKF("NO GO")="Occurrence entry locked; could not edit"
  1.  L +(^AQAGU(0)):1 I '$T D  G EXIT
  1.  .S AQALNKF("NO GO")="QI Audit file locked; could not edit"
  1.  D ^DIE L -(^AQAOC(AQALNK("OCC")))
  1.  ;
  1. AUDIT S AQAOUDIT("DA")=AQALNK("OCC"),AQAOUDIT("ACTION")="O"
  1.  S AQAOUDIT("COMMENT")="EDIT A RECORD-AUTO LINK" D ^AQAOAUD
  1.  ;
  1. SUMM ; >>> add xtra data to case summary wp field
  1.  S (AQALSTX,AQALST)=0
  1.  F  S AQALST=$O(AQALXTR(AQALST)) Q:AQALST=""  D
  1.  .S ^AQAOC(AQALIFN,"CASE",AQALST,0)=AQALXTR(AQALST),AQALSTX=AQALST
  1.  I '$D(^AQAOC(AQALIFN,"CASE",0)) S:+AQALSTX ^AQAOC(AQALIFN,"CASE",0)=U_U_AQALSTX_U_AQALSTX_U_DT
  1.  ;
  1. EXIT ; >>> eoj
  1.  K AQAOPAT,AQAODATE,AQAOIND,DIC,X,Y,I
  1.  I $D(AQALNKF),$D(AQALNK("BUL")) D ^AQALNKER Q  ;send error bulletin
  1.  W !!,"QAI Occurrence modified for this transaction: "
  1.  W "(",$P($P(^DD(AQALF,AQALEV,0),U),"LINK"),")",!
  1.  Q
  1.  ;
  1.  ;
  1. DEL(N) ;PEP; PUBLIC ENTRY POINT to delete an occurrence
  1.  ;input variable N=occ ifn
  1.  S AQALIFN=N
  1.  L +^AQAOC(AQALIFN):1 I '$T D  D EXIT Q
  1.  .S AQALNKF("NO GO")="Another user editing occ; cannot delete"
  1.  L +^AQAGU(0):1 I '$T D  D EXIT Q
  1.  .S AQALNKF("NO GO")="Audit file locked; cannot delete occurrence"
  1.  ;
  1.  S AQAOUDIT("DA")=AQALIFN,AQAOUDIT("ACTION")="D"
  1.  S AQAOUDIT("COMMENT")="DELETING RECORD-AUTO LINK" D ^AQAOAUD
  1.  S DIE="^AQAOC(",DA=AQALIFN,DR=".11////2;.112////EVENT EDITED IN RPMS"
  1.  D ^DIE L -^AQAOC(AQALIFN)
  1.  W !!,"QAI Occurrence deleted for this transaction: "
  1.  W "(",$P($G(^AQAO(2,$P(^AQAOC(AQALIFN,0),U,8),0)),U),")",!
  1.  Q