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

AQALNK.m

Go to the documentation of this file. 
  1. AQALNK ; IHS/ORDC/LJF - CREATES OCC FROM OTHER PKGS ;
  1.  ;;1;QI LINKAGES-RPMS;;AUG 15, 1994
  1.  ;
  1.  ;This rtn is available to RPMS packages that wish to automatically
  1.  ;create occurrence entries.  The input variables are:
  1.  ;
  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 for 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 point is CREATE^AQALNK.
  1.  ;
  1. CREATE ;PEP; PUBLIC ENTRY POINT to create occurrences
  1.  ; >>> check input variables
  1.  K AQALNKF,AQALIFN
  1.  F I="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 ;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. DUPCHECK ; >>> check if duplicate entry allowed
  1.  I $D(AQALNK("DUP OK")) G ADD ;okay to add duplicate entry
  1.  ;                            ;quit if occurrence already exists
  1.  G EXIT:$D(^AQAOC("AA",AQALNK("IND"),AQALNK("DATE"),AQALNK("PAT")))
  1.  ;
  1. ADD ; >>> 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=$$OCCID^AQAOCID ;create occ id number
  1.  I '$D(AQALCID) S AQALNKF("NO GO")="Couldn't create occ ID #" G EXIT
  1.  ;
  1.  K DD,DO,DIC S DIC="^AQAOC(",DIC(0)="L",X=AQALCID
  1.  S DIC("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(0)):1 I '$T D  G EXIT
  1.  .S AQALNKF("NO GO")="Occurrence file locked; could not add"
  1.  L +(^AQAGU(0)):1 I '$T D  G EXIT
  1.  .S AQALNKF("NO GO")="QI Audit file locked; could not add"
  1.  D FILE^DICN L -(^AQAOC(0))
  1.  I Y=-1 S AQALNKF("NO GO")="Add thru FILE^DICN didn't work" G EXIT
  1.  S AQALIFN=+Y
  1.  ;
  1. AUDIT S AQAOUDIT("DA")=AQALIFN,AQAOUDIT("ACTION")="O"
  1.  S AQAOUDIT("COMMENT")="OPEN A RECORD-AUTO LINK" D ^AQAOAUD
  1.  ;
  1. SUMM ; >>> add xtra data to case summary wp field
  1.  G EXIT:$O(^AQAOC(AQALIFN,"CASE",0)) ;already data in case summary 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.  S:+AQALSTX ^AQAOC(AQALIFN,"CASE",0)=U_U_AQALSTX_U_AQALSTX_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 created for this transaction: "
  1.  W "(",$P($P(^DD(AQALF,AQALEV,0),U),"LINK"),")",!
  1.  Q
  1.  ;
  1.  ;
  1. VARCHECK ;EP >>> SUBRTN to check input variables
  1.  ;called by this rtn and ^AQALNK1
  1.  I '$D(^DPT(AQALNK("PAT"),0)) S AQALNKF("PAT")="Bad patient DFN" Q
  1.  S:$P(^DPT(AQALNK("PAT"),0),U,19)'="" AQALNKF("PAT")="Merged Patient"
  1.  S:'$D(^AQAO(2,AQALNK("IND"),0)) AQALNKF("IND")="Bad indicator ifn" Q
  1.  S:$P(^AQAO(2,AQALNK("IND"),0),U,6)="I" AQALNKF("IND")="Inactive indicator"
  1.  I $G(AQALNK("VSIT"))>0 D
  1.  .S:'$D(^AUPNVSIT(AQALNK("VSIT"),0)) AQALNKF("VSIT")="Bad visit ifn" Q
  1.  .S X=^AUPNVSIT(AQALNK("VSIT"),0) ;set visit node
  1.  .S:$P(X,U,11)=1 AQALNKF("VSIT")="Deleted visit"
  1.  .S:$P(X,U,5)'=AQALNK("PAT") AQALNKF("VSIT")="Visit not for patient"
  1.  S:'$D(^APCDSITE("B",AQALNK("FAC"))) AQALNKF("FAC")="Not PCC site"
  1.  S:'$D(^AUPNPAT(AQALNK("PAT"),41,AQALNK("FAC"),0)) AQALNKF("FAC")="Patient doesn't have chart # for facility"
  1.  S X=AQALNK("DATE") I +X<1000000 S AQALNKF("DATE")="Invalid date"
  1.  I (X<1000000)!(X>DT) S AQALNKF("DATE")="Can't have future dates"
  1.  I X<$P(^DPT(AQALNK("PAT"),0),U,3) S AQALNKF("DATE")="Occ before DOB"
  1.  Q:'$D(^DPT(AQALNK("PAT"),.35))  I $P(^(.35),U)="" Q  ;not dead
  1.  I X>+^DPT(AQALNK("PAT"),.35) S AQALNKF("DATE")="Occ after DOD"
  1.  Q