AQAOENTR ; IHS/ORDC/LJF - ENTER OR EDIT AN OCCURRENCE ;
;;1.01;QAI MANAGEMENT;;OCT 05, 1995
;
;This is the main rtn for occurrence data entry. It is used for
;adding new occurrences, editing occ data and initial reviews, and
;creating occurrences from visit-based search templates.
;
CHOOSE ; >>> choose add new occurrence or edit open one
I $D(AQAOIFN) L -^AQAOC(AQAOIFN) K AQAOIFN ;unlock previous occ
D INTRO^AQAOHOCC ;intro text for option
K DIR S DIR(0)="SO^A:ADD NEW OCCURRENCE;C:CREATE ENTRIES FROM SEARCH TEMPLATE;E:EDIT EXISTING OCCURRENCE"
S DIR("A")="Choose the ACTION you wish to perform" D ^DIR
G EXIT:X="",EXIT:$D(DIRUT),CHOOSE:Y=-1
;
; >>> use proper lookup then edit occurrence data
I Y="C" D ^AQAOENTS G CHOOSE ;separate code for occ from searches
; ;if for edit, get occ, drop to visit
I Y="E" D G EXIT:'$D(AQAOIFN),CHOOSE:$D(DUOUT),EXIT:$D(DTOUT)
.D ASK^AQAOLKP
; ;add new one, drop to visit line
E D ADD^AQAOLKP G EXIT:'$D(AQAOIFN),CHOOSE:$D(DUOUT),EXIT:$D(DTOUT)
;
;
VISIT ; >>> look up and add patient's visit
L +^AQAOC(AQAOIFN):1 I '$T D G CHOOSE ;lock occ
.W !!,"CANNOT EDIT; ANOTHER USER IS EDITING THIS OCCURRENCE.",!
L +^AQAGU(0):1 I '$T D G CHOOSE ;lock audit file
.W !!,"CANNOT EDIT OCCURRENCE; AUDIT FILE LOCKED. TRY AGAIN.",!
S AQAOUDIT("DA")=AQAOIFN,AQAOUDIT("ACTION")="E"
S AQAOUDIT("COMMENT")="EDIT OCCURRENCE" D ^AQAOAUD ;record transact
;
W ! S AQAOVSIT=$P($G(^AQAO(2,$P(^AQAOC(AQAOIFN,0),U,8),1)),U,2)
G EDIT:AQAOVSIT'="Y" ;not visit related
G EDIT:$P(^AQAOC(AQAOIFN,0),U,3)'="" ;visit already in occurrence
D VISIT^AQAOHOCC ;help text on visit
W !! K DIR S DIR(0)="D^::EX",DIR("?")="^D VHELP^AQAOHOCC" ;PATCH 3
S DIR("A")="Enter VISIT DATE" D ^DIR
G EDIT:Y=U I Y<0 W *7,"??" G EDIT ;PATCH 3
S APCDVLDT=Y ;date sent to pcc lookup rtn for visit ifn
;set APCDOVRR to override screen that dep entry count must be >1
S APCDPAT=AQAOPAT,(APCDOVRR,APCDLOOK,APCDVSIT)=""
D ^APCDVLK K APCDOVRR,APCDLOOK ;visit lookup needs only date
G EDIT:X=U I APCDVSIT="" W *7,"??" G EDIT ;PATCH 3
S AQAOSTR=$G(^AUPNVSIT(APCDVSIT,0))
S DIE="^AQAOC(",DA=AQAOIFN S DR=".03////"_APCDVSIT D ^DIE ;stuff vsit
K APCDCAT,APCDCLN,APCDDATE,APCDLOC,APCDPAT,APCDTYPE,APCDVSIT,APCDVLDT
;
;
EDIT ; >>> edit basic occurrence data
; >> find review type entered then loop thru fields
S AQAOIND=$P(^AQAOC(AQAOIFN,0),U,8) G ASKREVU:AQAOIND="" ;ind ifn
S AQAORT=$P($G(^AQAO(2,AQAOIND,1)),U) G ASKREVU:AQAORT="" ;revtyp ifn
S AQAOPT=$P(^AQAO(3,AQAORT,0),U,3) G ASKREVU:AQAOPT="" ;driver ifn
D ^AQAOEDTS ;data entry driver
;
; >> edit case summary field
W !! D CSUM^AQAOHOCC S DIE="^AQAOC(",DA=AQAOIFN,DR="2" D ^DIE
I $D(Y) G CHOOSE ;user entered "^"
;
;
ASKREVU ; >>> ask to begin review process
;
; if rate-based, stuff review then continue
I $P(^AQAO(2,AQAOIND,0),U,4)="R",$P(^(1),U,4)]"",$P(^(1),U,5)]"",$P(^(1),U,6)]"",$P(^AQAOC(AQAOIFN,1),U,6)="" D G CLOSE
.L +^AQAGU(0):1 I '$T D G CHOOSE
..W !!,"CANNOT ENTER REVIEW; AUDIT FILE LOCKED. TRY AGAIN.",!
.S AQAOUDIT("COMMENT")="REVIEW STUFFED",AQAOUDIT("DA")=AQAOIFN
.S AQAOUDIT("ACTION")="E" D ^AQAOAUD ;audit review
.W !! K DIR S DA=AQAOIFN,DIE="^AQAOC(",DR="[AQAO RATE REVIEW]" D ^DIE
.W !!,"Initial Review Recorded. . ."
;
; otherwise ask if user wants to enter initial review
W !! K DIR S DIR(0)="Y",DIR("B")="NO"
S DIR("A")="DO YOU WISH TO START REVIEW PROCESS FOR THIS ENTRY"
D ^DIR G EXIT:$D(DIRUT) I Y=0 W @IOF G CHOOSE
;
I $P($G(^AQAOC(AQAOIFN,1)),U,6)]"" D I Y'=1 G CLOSE
.W !!,*7,"INITIAL REVIEW already performed!"
.K DIR S DIR(0)="Y",DIR("B")="NO"
.S DIR("A")="Do you wish to edit this INITIAL REVIEW" D ^DIR
;
INITIAL ; >>> enter initial review data
L +^AQAGU(0):1 I '$T D G CHOOSE
.W !!,"CANNOT ENTER REVIEW; AUDIT FILE LOCKED. TRY AGAIN.",!
S AQAOUDIT("COMMENT")="INITIAL REVIEW",AQAOUDIT("DA")=AQAOIFN
S AQAOUDIT("ACTION")="E" D ^AQAOAUD ;audit review
W !! K DIR S DA=AQAOIFN,DIE="^AQAOC(",DR="[AQAO FIRST REVIEW]"
D ^DIE
;
;if initial action is practitioner-based, flag providers
S AQAOACT=$P(^AQAOC(AQAOIFN,1),U,6) ;initial action
I AQAOACT]"",$P(^AQAO(6,AQAOACT,0),U,4)=2 D ;practitioner-based
.S AQAOPT=$O(^AQAQX("B","AQAO PROV ACTION",0)) Q:AQAOPT=""
.K AQAOP D ^AQAOEDTS ;call driver
;
W !!,"INITIAL REVIEW COMPLETE . . ." H 2
;
CLOSE ;if user has close out key AND initial action not referral AND
;no other reviews exist for occ THEN user has chance to close out occ
I $D(^XUSEC("AQAOZCLS",DUZ)),$P(^AQAOC(AQAOIFN,1),U,6)]"",$P(^AQAO(6,$P(^AQAOC(AQAOIFN,1),U,6),0),U,4)'=1,'$O(^AQAOC(AQAOIFN,"REV",0)) D
.S AQAOENTR="" D CLOSE^AQAOVAL K AQAOENTR
;
;
G CHOOSE
;
;
EXIT ; >>> eoj
I $D(AQAOIFN) L -^AQAOC(AQAOIFN)
D KILL^AQAOUTIL Q
;
;
ERROR ; >>> SUBRTN to print error msg
W !!,*7,"COULD NOT ADD OCCURRENCE TO FILE! PLEASE SEE SITE MANAGER!"
W !! G EXIT
AQAOENTR ; IHS/ORDC/LJF - ENTER OR EDIT AN OCCURRENCE ;
+1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
+2 ;
+3 ;This is the main rtn for occurrence data entry. It is used for
+4 ;adding new occurrences, editing occ data and initial reviews, and
+5 ;creating occurrences from visit-based search templates.
+6 ;
CHOOSE ; >>> choose add new occurrence or edit open one
+1 ;unlock previous occ
IF $DATA(AQAOIFN)
LOCK -^AQAOC(AQAOIFN)
KILL AQAOIFN
+2 ;intro text for option
DO INTRO^AQAOHOCC
+3 KILL DIR
SET DIR(0)="SO^A:ADD NEW OCCURRENCE;C:CREATE ENTRIES FROM SEARCH TEMPLATE;E:EDIT EXISTING OCCURRENCE"
+4 SET DIR("A")="Choose the ACTION you wish to perform"
DO ^DIR
+5 IF X=""
GOTO EXIT
IF $DATA(DIRUT)
GOTO EXIT
IF Y=-1
GOTO CHOOSE
+6 ;
+7 ; >>> use proper lookup then edit occurrence data
+8 ;separate code for occ from searches
IF Y="C"
DO ^AQAOENTS
GOTO CHOOSE
+9 ; ;if for edit, get occ, drop to visit
+10 IF Y="E"
Begin DoDot:1
+11 DO ASK^AQAOLKP
End DoDot:1
IF '$DATA(AQAOIFN)
GOTO EXIT
IF $DATA(DUOUT)
GOTO CHOOSE
IF $DATA(DTOUT)
GOTO EXIT
+12 ; ;add new one, drop to visit line
+13 IF '$TEST
DO ADD^AQAOLKP
IF '$DATA(AQAOIFN)
GOTO EXIT
IF $DATA(DUOUT)
GOTO CHOOSE
IF $DATA(DTOUT)
GOTO EXIT
+14 ;
+15 ;
VISIT ; >>> look up and add patient's visit
+1 ;lock occ
LOCK +^AQAOC(AQAOIFN):1
IF '$TEST
Begin DoDot:1
+2 WRITE !!,"CANNOT EDIT; ANOTHER USER IS EDITING THIS OCCURRENCE.",!
End DoDot:1
GOTO CHOOSE
+3 ;lock audit file
LOCK +^AQAGU(0):1
IF '$TEST
Begin DoDot:1
+4 WRITE !!,"CANNOT EDIT OCCURRENCE; AUDIT FILE LOCKED. TRY AGAIN.",!
End DoDot:1
GOTO CHOOSE
+5 SET AQAOUDIT("DA")=AQAOIFN
SET AQAOUDIT("ACTION")="E"
+6 ;record transact
SET AQAOUDIT("COMMENT")="EDIT OCCURRENCE"
DO ^AQAOAUD
+7 ;
+8 WRITE !
SET AQAOVSIT=$PIECE($GET(^AQAO(2,$PIECE(^AQAOC(AQAOIFN,0),U,8),1)),U,2)
+9 ;not visit related
IF AQAOVSIT'="Y"
GOTO EDIT
+10 ;visit already in occurrence
IF $PIECE(^AQAOC(AQAOIFN,0),U,3)'=""
GOTO EDIT
+11 ;help text on visit
DO VISIT^AQAOHOCC
+12 ;PATCH 3
WRITE !!
KILL DIR
SET DIR(0)="D^::EX"
SET DIR("?")="^D VHELP^AQAOHOCC"
+13 SET DIR("A")="Enter VISIT DATE"
DO ^DIR
+14 ;PATCH 3
IF Y=U
GOTO EDIT
IF Y<0
WRITE *7,"??"
GOTO EDIT
+15 ;date sent to pcc lookup rtn for visit ifn
SET APCDVLDT=Y
+16 ;set APCDOVRR to override screen that dep entry count must be >1
+17 SET APCDPAT=AQAOPAT
SET (APCDOVRR,APCDLOOK,APCDVSIT)=""
+18 ;visit lookup needs only date
DO ^APCDVLK
KILL APCDOVRR,APCDLOOK
+19 ;PATCH 3
IF X=U
GOTO EDIT
IF APCDVSIT=""
WRITE *7,"??"
GOTO EDIT
+20 SET AQAOSTR=$GET(^AUPNVSIT(APCDVSIT,0))
+21 ;stuff vsit
SET DIE="^AQAOC("
SET DA=AQAOIFN
SET DR=".03////"_APCDVSIT
DO ^DIE
+22 KILL APCDCAT,APCDCLN,APCDDATE,APCDLOC,APCDPAT,APCDTYPE,APCDVSIT,APCDVLDT
+23 ;
+24 ;
EDIT ; >>> edit basic occurrence data
+1 ; >> find review type entered then loop thru fields
+2 ;ind ifn
SET AQAOIND=$PIECE(^AQAOC(AQAOIFN,0),U,8)
IF AQAOIND=""
GOTO ASKREVU
+3 ;revtyp ifn
SET AQAORT=$PIECE($GET(^AQAO(2,AQAOIND,1)),U)
IF AQAORT=""
GOTO ASKREVU
+4 ;driver ifn
SET AQAOPT=$PIECE(^AQAO(3,AQAORT,0),U,3)
IF AQAOPT=""
GOTO ASKREVU
+5 ;data entry driver
DO ^AQAOEDTS
+6 ;
+7 ; >> edit case summary field
+8 WRITE !!
DO CSUM^AQAOHOCC
SET DIE="^AQAOC("
SET DA=AQAOIFN
SET DR="2"
DO ^DIE
+9 ;user entered "^"
IF $DATA(Y)
GOTO CHOOSE
+10 ;
+11 ;
ASKREVU ; >>> ask to begin review process
+1 ;
+2 ; if rate-based, stuff review then continue
+3 IF $PIECE(^AQAO(2,AQAOIND,0),U,4)="R"
IF $PIECE(^(1),U,4)]""
IF $PIECE(^(1),U,5)]""
IF $PIECE(^(1),U,6)]""
IF $PIECE(^AQAOC(AQAOIFN,1),U,6)=""
Begin DoDot:1
+4 LOCK +^AQAGU(0):1
IF '$TEST
Begin DoDot:2
+5 WRITE !!,"CANNOT ENTER REVIEW; AUDIT FILE LOCKED. TRY AGAIN.",!
End DoDot:2
GOTO CHOOSE
+6 SET AQAOUDIT("COMMENT")="REVIEW STUFFED"
SET AQAOUDIT("DA")=AQAOIFN
+7 ;audit review
SET AQAOUDIT("ACTION")="E"
DO ^AQAOAUD
+8 WRITE !!
KILL DIR
SET DA=AQAOIFN
SET DIE="^AQAOC("
SET DR="[AQAO RATE REVIEW]"
DO ^DIE
+9 WRITE !!,"Initial Review Recorded. . ."
End DoDot:1
GOTO CLOSE
+10 ;
+11 ; otherwise ask if user wants to enter initial review
+12 WRITE !!
KILL DIR
SET DIR(0)="Y"
SET DIR("B")="NO"
+13 SET DIR("A")="DO YOU WISH TO START REVIEW PROCESS FOR THIS ENTRY"
+14 DO ^DIR
IF $DATA(DIRUT)
GOTO EXIT
IF Y=0
WRITE @IOF
GOTO CHOOSE
+15 ;
+16 IF $PIECE($GET(^AQAOC(AQAOIFN,1)),U,6)]""
Begin DoDot:1
+17 WRITE !!,*7,"INITIAL REVIEW already performed!"
+18 KILL DIR
SET DIR(0)="Y"
SET DIR("B")="NO"
+19 SET DIR("A")="Do you wish to edit this INITIAL REVIEW"
DO ^DIR
End DoDot:1
IF Y'=1
GOTO CLOSE
+20 ;
INITIAL ; >>> enter initial review data
+1 LOCK +^AQAGU(0):1
IF '$TEST
Begin DoDot:1
+2 WRITE !!,"CANNOT ENTER REVIEW; AUDIT FILE LOCKED. TRY AGAIN.",!
End DoDot:1
GOTO CHOOSE
+3 SET AQAOUDIT("COMMENT")="INITIAL REVIEW"
SET AQAOUDIT("DA")=AQAOIFN
+4 ;audit review
SET AQAOUDIT("ACTION")="E"
DO ^AQAOAUD
+5 WRITE !!
KILL DIR
SET DA=AQAOIFN
SET DIE="^AQAOC("
SET DR="[AQAO FIRST REVIEW]"
+6 DO ^DIE
+7 ;
+8 ;if initial action is practitioner-based, flag providers
+9 ;initial action
SET AQAOACT=$PIECE(^AQAOC(AQAOIFN,1),U,6)
+10 ;practitioner-based
IF AQAOACT]""
IF $PIECE(^AQAO(6,AQAOACT,0),U,4)=2
Begin DoDot:1
+11 SET AQAOPT=$ORDER(^AQAQX("B","AQAO PROV ACTION",0))
IF AQAOPT=""
QUIT
+12 ;call driver
KILL AQAOP
DO ^AQAOEDTS
End DoDot:1
+13 ;
+14 WRITE !!,"INITIAL REVIEW COMPLETE . . ."
HANG 2
+15 ;
CLOSE ;if user has close out key AND initial action not referral AND
+1 ;no other reviews exist for occ THEN user has chance to close out occ
+2 IF $DATA(^XUSEC("AQAOZCLS",DUZ))
IF $PIECE(^AQAOC(AQAOIFN,1),U,6)]""
IF $PIECE(^AQAO(6,$PIECE(^AQAOC(AQAOIFN,1),U,6),0),U,4)'=1
IF '$ORDER(^AQAOC(AQAOIFN,"REV",0))
Begin DoDot:1
+3 SET AQAOENTR=""
DO CLOSE^AQAOVAL
KILL AQAOENTR
End DoDot:1
+4 ;
+5 ;
+6 GOTO CHOOSE
+7 ;
+8 ;
EXIT ; >>> eoj
+1 IF $DATA(AQAOIFN)
LOCK -^AQAOC(AQAOIFN)
+2 DO KILL^AQAOUTIL
QUIT
+3 ;
+4 ;
ERROR ; >>> SUBRTN to print error msg
+1 WRITE !!,*7,"COULD NOT ADD OCCURRENCE TO FILE! PLEASE SEE SITE MANAGER!"
+2 WRITE !!
GOTO EXIT
