AQAOLKP.m

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)