AQAOLKP ; IHS/ORDC/LJF - LOOKUP UTILITIES ;
;;1.01;QAI MANAGEMENT;;OCT 05, 1995
;
;This rtn contains entry points for occurrence selection, adding an
;occurrence and extrinsic variables for asking user to select occ
;date, indicator, beginning date, and ending date. Also includes
;extrinsic variable for a screen on review type.
;
ASK ;ENTRY POINT for selecting occurrence
; >>> ask for occ id or patient name or indicator
K AQAOIFN W !! K DIC S DIC="^AQAOC(",DIC(0)="AEMQZ"
S DIC("A")="Select OCCURRENCE (ID #, Patient, or Indicator): "
S DIC("S")="D OCCCHK^AQAOSEC I $D(AQAOCHK(""OK""))"
D ^DIC Q:$D(DTOUT) Q:$D(DUOUT) Q:X="" Q:Y=-1
S AQAOIFN=+Y,AQAOCID=Y(0,0)
S AQAOPAT=$P(Y(0),U,2),AQAOIND=$P(Y(0),U,8),AQAODATE=$P(Y(0),U,4)
;
; >> display occurrence
S L="",DIC="^AQAOC(",FLDS="[AQAO OCC SHORT DISPLAY]"
S BY="@NUMBER",(TO,FR)=AQAOIFN,IOP=IO(0) D EN1^DIP ;display occurrence
K DIR S DIR(0)="E"
S DIR("A")="Press RETURN to continue OR '^' to select another occurrence"
D ^DIR
Q
;
;
ADD ;ENTRY POINT for adding new occurrence
; >>> ask patient name & date & indicator then enter
W ! K DIC S DIC="^DPT(",DIC(0)="AEMQ" D ^DIC Q:Y=-1 S AQAOPAT=+Y
;
W ! S %DT="AEX",%DT("A")="Enter OCCURRENCE DATE: " D ^%DT
G:Y=-1 ADD S AQAODATE=+Y
;
W ! K DIC S DIC="^AQAO(2,",DIC(0)="AEMQ" ;indicator lookup
S DIC("S")="D INDCHK^AQAOSEC I $D(AQAOCHK(""OK"")),+$G(^AQAO(2,Y,1))"
S DIC("A")="Enter CLINICAL INDICATOR: "
D ^DIC K AQAOCHK("OK") W ! G:Y=-1 ADD S AQAOIND=+Y
;
;
CHECK ; >>> check if occurrence already entered; if so go to edit
D ^AQAOENTQ I $D(DIRUT) K DIRUT G ADD
I $D(AQAO) S AQAOUDIT("DA")=AQAOIFN,AQAOUDIT("ACTION")="E",AQAOUDIT("COMMENT")="EDIT OCCURRENCE" D ^AQAOAUD Q
D CREATE G ASK:'$D(AQAOCID)
Q
;
;
CREATE ;ENTRY POINT else, create case identifier than add entry
W !!,"Please wait while I create the occurrence entry . . ."
S AQAOCID=$$OCCID^AQAOCID Q:AQAOCID=""
S DIC="^AQAOC(",DIC(0)="AEMQ"
S DIC("DR")=".02////"_AQAOPAT_";.04////"_AQAODATE_";.08////"_AQAOIND_";.09////"_DUZ(2)_";.11///^S X=0"
L +^AQAGU(0):1 I '$T W !!,"CANNOT ADD; AUDIT FILE LOCKED. TRY AGAIN.",! Q
L +(^AQAOC(0)):1 I '$T W !,"CANNOT ADD NEW ENTRY; ANOTHER USER ADDING TO FILE. TRY AGAIN." Q
S X=AQAOCID K DD,DO,DINUM D FILE^DICN K DIC("DR")
L -(^AQAOC(0)):0 I Y=-1 L -^AQAGU(0) Q
S AQAOIFN=+Y ;ifn in qi occurrence file
W !!,"Your CASE # is ",AQAOCID,!
;
AUDIT S AQAOUDIT("DA")=AQAOIFN,AQAOUDIT("ACTION")="O"
S AQAOUDIT("COMMENT")="OPEN A RECORD" D ^AQAOAUD
Q
;
;
OCCDT(V) ;ENTRY POINT EXTR FUNC to ask user for occ date;PATCH 2
N Y,%DT
W ! S %DT="AEX",%DT("A")="Enter OCCURRENCE DATE: "
S %DT("B")=V D ^%DT ;PATCH 2
Q Y
;
;
IND() ;ENTRY POINT EXTR VAR to ask user for indicator
N DIC,Y
W !! S DIC="^AQAO(2,",DIC(0)="AEMQZ"
S DIC("S")="D INDCHK^AQAOSEC I $D(AQAOCHK(""OK""))"
S DIC("A")="Enter CLINICAL INDICATOR: " D ^DIC K AQAOCHK("OK")
I $D(DTOUT)!($D(DUOUT))!(X="") S Y=U
Q Y
;
;
BDATE() ;ENTRY POINT EXTR VAR ask user to choose beginning date for report
BD1 N DIR,Y
W !! S DIR(0)="DO^::EX",DIR("A")="Select EARLIEST OCCURRENCE DATE"
D ^DIR I Y>DT W *7," NO FUTURE DATES" G BD1
S Y=$S(Y>0:Y,$D(DTOUT):U,1:"")
Q Y
;
EDATE() ;ENTRY POINT EXTR VAR ask user to choose ending date for report
ED1 N DIR,Y
W ! S DIR(0)="DO^::EX",DIR("A")="Select LATEST OCCURRENCE DATE"
D ^DIR I Y>DT W *7," NO FUTURE DATES" G ED1
I +Y,(Y<AQAOBD) W *7," ENDING DATE MUST BE AFTER BEGINNING DATE" S Y=""
S Y=$S(Y>0:Y,$D(DTOUT):U,1:"")
Q Y
;
;
RTYPE() ;EP; EXTRN VAR - screen on selecting review types
; to select BTR must have Blood Product file
; to select PTF must have Drug file
N X S X=0
I (Y<3)!(Y>5) S X=1 G RTEND ;not type that needs screen
I (Y=3),$O(^LAB(66,0)) S X=1 G RTEND ;check for blood product file
I $O(^PSDRUG(0)),$D(^DD(50.6,0))#2 S X=1 ;check for drug file
RTEND Q X
;
EXCEP(X) ;EP; EXTRN FUNC to test whether ind has exception recorded
Q $S($P($G(^AQAOC(X,1)),U,2)]"":1,1:0)
AQAOLKP ; IHS/ORDC/LJF - LOOKUP UTILITIES ;
+1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
+2 ;
+3 ;This rtn contains entry points for occurrence selection, adding an
+4 ;occurrence and extrinsic variables for asking user to select occ
+5 ;date, indicator, beginning date, and ending date. Also includes
+6 ;extrinsic variable for a screen on review type.
+7 ;
ASK ;ENTRY POINT for selecting occurrence
+1 ; >>> ask for occ id or patient name or indicator
+2 KILL AQAOIFN
WRITE !!
KILL DIC
SET DIC="^AQAOC("
SET DIC(0)="AEMQZ"
+3 SET DIC("A")="Select OCCURRENCE (ID #, Patient, or Indicator): "
+4 SET DIC("S")="D OCCCHK^AQAOSEC I $D(AQAOCHK(""OK""))"
+5 DO ^DIC
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
IF X=""
QUIT
IF Y=-1
QUIT
+6 SET AQAOIFN=+Y
SET AQAOCID=Y(0,0)
+7 SET AQAOPAT=$PIECE(Y(0),U,2)
SET AQAOIND=$PIECE(Y(0),U,8)
SET AQAODATE=$PIECE(Y(0),U,4)
+8 ;
+9 ; >> display occurrence
+10 SET L=""
SET DIC="^AQAOC("
SET FLDS="[AQAO OCC SHORT DISPLAY]"
+11 ;display occurrence
SET BY="@NUMBER"
SET (TO,FR)=AQAOIFN
SET IOP=IO(0)
DO EN1^DIP
+12 KILL DIR
SET DIR(0)="E"
+13 SET DIR("A")="Press RETURN to continue OR '^' to select another occurrence"
+14 DO ^DIR
+15 QUIT
+16 ;
+17 ;
ADD ;ENTRY POINT for adding new occurrence
+1 ; >>> ask patient name & date & indicator then enter
+2 WRITE !
KILL DIC
SET DIC="^DPT("
SET DIC(0)="AEMQ"
DO ^DIC
IF Y=-1
QUIT
SET AQAOPAT=+Y
+3 ;
+4 WRITE !
SET %DT="AEX"
SET %DT("A")="Enter OCCURRENCE DATE: "
DO ^%DT
+5 IF Y=-1
GOTO ADD
SET AQAODATE=+Y
+6 ;
+7 ;indicator lookup
WRITE !
KILL DIC
SET DIC="^AQAO(2,"
SET DIC(0)="AEMQ"
+8 SET DIC("S")="D INDCHK^AQAOSEC I $D(AQAOCHK(""OK"")),+$G(^AQAO(2,Y,1))"
+9 SET DIC("A")="Enter CLINICAL INDICATOR: "
+10 DO ^DIC
KILL AQAOCHK("OK")
WRITE !
IF Y=-1
GOTO ADD
SET AQAOIND=+Y
+11 ;
+12 ;
CHECK ; >>> check if occurrence already entered; if so go to edit
+1 DO ^AQAOENTQ
IF $DATA(DIRUT)
KILL DIRUT
GOTO ADD
+2 IF $DATA(AQAO)
SET AQAOUDIT("DA")=AQAOIFN
SET AQAOUDIT("ACTION")="E"
SET AQAOUDIT("COMMENT")="EDIT OCCURRENCE"
DO ^AQAOAUD
QUIT
+3 DO CREATE
IF '$DATA(AQAOCID)
GOTO ASK
+4 QUIT
+5 ;
+6 ;
CREATE ;ENTRY POINT else, create case identifier than add entry
+1 WRITE !!,"Please wait while I create the occurrence entry . . ."
+2 SET AQAOCID=$$OCCID^AQAOCID
IF AQAOCID=""
QUIT
+3 SET DIC="^AQAOC("
SET DIC(0)="AEMQ"
+4 SET DIC("DR")=".02////"_AQAOPAT_";.04////"_AQAODATE_";.08////"_AQAOIND_";.09////"_DUZ(2)_";.11///^S X=0"
+5 LOCK +^AQAGU(0):1
IF '$TEST
WRITE !!,"CANNOT ADD; AUDIT FILE LOCKED. TRY AGAIN.",!
QUIT
+6 LOCK +(^AQAOC(0)):1
IF '$TEST
WRITE !,"CANNOT ADD NEW ENTRY; ANOTHER USER ADDING TO FILE. TRY AGAIN."
QUIT
+7 SET X=AQAOCID
KILL DD,DO,DINUM
DO FILE^DICN
KILL DIC("DR")
+8 LOCK -(^AQAOC(0)):0
IF Y=-1
LOCK -^AQAGU(0)
QUIT
+9 ;ifn in qi occurrence file
SET AQAOIFN=+Y
+10 WRITE !!,"Your CASE # is ",AQAOCID,!
+11 ;
AUDIT SET AQAOUDIT("DA")=AQAOIFN
SET AQAOUDIT("ACTION")="O"
+1 SET AQAOUDIT("COMMENT")="OPEN A RECORD"
DO ^AQAOAUD
+2 QUIT
+3 ;
+4 ;
OCCDT(V) ;ENTRY POINT EXTR FUNC to ask user for occ date;PATCH 2
+1 NEW Y,%DT
+2 WRITE !
SET %DT="AEX"
SET %DT("A")="Enter OCCURRENCE DATE: "
+3 ;PATCH 2
SET %DT("B")=V
DO ^%DT
+4 QUIT Y
+5 ;
+6 ;
IND() ;ENTRY POINT EXTR VAR to ask user for indicator
+1 NEW DIC,Y
+2 WRITE !!
SET DIC="^AQAO(2,"
SET DIC(0)="AEMQZ"
+3 SET DIC("S")="D INDCHK^AQAOSEC I $D(AQAOCHK(""OK""))"
+4 SET DIC("A")="Enter CLINICAL INDICATOR: "
DO ^DIC
KILL AQAOCHK("OK")
+5 IF $DATA(DTOUT)!($DATA(DUOUT))!(X="")
SET Y=U
+6 QUIT Y
+7 ;
+8 ;
BDATE() ;ENTRY POINT EXTR VAR ask user to choose beginning date for report
BD1 NEW DIR,Y
+1 WRITE !!
SET DIR(0)="DO^::EX"
SET DIR("A")="Select EARLIEST OCCURRENCE DATE"
+2 DO ^DIR
IF Y>DT
WRITE *7," NO FUTURE DATES"
GOTO BD1
+3 SET Y=$SELECT(Y>0:Y,$DATA(DTOUT):U,1:"")
+4 QUIT Y
+5 ;
EDATE() ;ENTRY POINT EXTR VAR ask user to choose ending date for report
ED1 NEW DIR,Y
+1 WRITE !
SET DIR(0)="DO^::EX"
SET DIR("A")="Select LATEST OCCURRENCE DATE"
+2 DO ^DIR
IF Y>DT
WRITE *7," NO FUTURE DATES"
GOTO ED1
+3 IF +Y
IF (Y<AQAOBD)
WRITE *7," ENDING DATE MUST BE AFTER BEGINNING DATE"
SET Y=""
+4 SET Y=$SELECT(Y>0:Y,$DATA(DTOUT):U,1:"")
+5 QUIT Y
+6 ;
+7 ;
RTYPE() ;EP; EXTRN VAR - screen on selecting review types
+1 ; to select BTR must have Blood Product file
+2 ; to select PTF must have Drug file
+3 NEW X
SET X=0
+4 ;not type that needs screen
IF (Y<3)!(Y>5)
SET X=1
GOTO RTEND
+5 ;check for blood product file
IF (Y=3)
IF $ORDER(^LAB(66,0))
SET X=1
GOTO RTEND
+6 ;check for drug file
IF $ORDER(^PSDRUG(0))
IF $DATA(^DD(50.6,0))#2
SET X=1
RTEND QUIT X
+1 ;
EXCEP(X) ;EP; EXTRN FUNC to test whether ind has exception recorded
+1 QUIT $SELECT($PIECE($GET(^AQAOC(X,1)),U,2)]"":1,1:0)
