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

AQAOENTR.m

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