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