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

APCDEA2.m

Go to the documentation of this file. 
  1. APCDEA2 ; IHS/CMI/LAB - DATA ENTRY ENTER CONT. ;
  1.  ;;2.0;IHS PCC SUITE;**17**;MAY 14, 2009;Build 18
  1.  ;   Generate VISIT, then process MNEMONICS/TEMPLATE
  1.  ;BJPC v1.0 patch 1
  1. START ;
  1.  S APCDX=""
  1.  I $D(APCDLPAT),APCDLPAT=APCDPAT,$D(APCDLDAT),APCDLDAT=APCDDATE,$D(APCDLVST),'APCDTPLT D SAMEPAT
  1.  S APCDLPAT=APCDPAT
  1.  S APCDLDAT=APCDDATE
  1.  I APCDX=1 D MNEPROC Q
  1.  Q:APCDX=2
  1.  K APCDLVST,APCDCLN,ZTSK
  1.  I $D(APCDTVST) S APCDTYPE=APCDTTYP,APCDCAT=APCDTCAT,APCDLOC=APCDTLOC K APCDTVST,APCDTTYP,APCDTCAT,APCDTLOC
  1.  K APCDALVR D ^APCDALV
  1.  I $D(APCDAFLG)#2,APCDAFLG=2 W $C(7),!,"VISIT date not valid for current patient!",! S APCDFLG=1 Q
  1.  Q:APCDVSIT=""
  1.  ;I $D(APCDVSIT("NEW")),$P(^APCCCTRL(DUZ(2),0),U,12)]"",$P($P(^AUPNVSIT(APCDVSIT,0),U),".")'<$P(^APCCCTRL(DUZ(2),0),U,12) S DA=APCDVSIT,DIE="^AUPNVSIT(",DR="1111///R" D ^DIE K DIE,DA,DR
  1.  ;above added for EHR and auditing of visits, d/e created
  1.  ;visits are always set to "R"
  1.  S APCDLVST=APCDVSIT
  1.  S DIE="^AUPNPAT(",DR=".16///TODAY",DA=APCDPAT D ^DIE
  1.  ;S DIE="^AUPNVSIT(",DA=APCDVSIT,DR=".13////"_DT D ^DIE K DR,DA,DIE
  1.  S AUPNVSIT=APCDVSIT D MOD^AUPNVSIT
  1.  I AUPNDOB]"" S X2=AUPNDOB,X1=APCDDATE D ^%DTC S AUPNDAYS=X
  1.  I APCDTPLT S APCDMNE=APCDTPLT D ^APCDEA3,GETMNEK Q
  1.  K DR
  1.  I $P($G(APCDPARM),U,18)'="N" S APCDVDSP=APCDVSIT D:$D(APCDVSIT("NEW")) ^APCDVDSP D:'$D(APCDVSIT("NEW")) ^APCDEWHA K APCDVDSP
  1.  I APCDTYPE'="C","TC"'[APCDCAT,'$D(APCDVSIT("NEW")) S X="TM" D GET1
  1.  I $P($G(APCDPARM),U,16)="Y",$E($P(^AUTTLOC(APCDLOC,0),U,10),5,6)>49 S X="OLOC" D GET1
  1.  I $D(APCDMINI),APCDTYPE'="C" D
  1.  .S X=$S(APCDCAT'="H":"CL",1:"IP") D GET1
  1.  .S APCDAMN=0 F  S APCDAMN=$O(^APCDSITE(DUZ(2),12,APCDAMN)) Q:APCDAMN'=+APCDAMN  S X=$P(^APCDTKW($P(^APCDSITE(DUZ(2),12,APCDAMN,0),U),0),U) D GET1
  1.  .F X="PRV","PV" D GET1
  1.  .Q
  1.  I APCDCAT="H",APCDTYPE'="C",'$D(APCDMINI),'$D(^AUPNVINP("AD",APCDVSIT)) S X="IP" D GET1
  1.  D MNEPROC
  1.  Q
  1.  ;
  1. MNEPROC ; PROCESS MNEMONICS UNTIL DONE
  1.  S APCDMPQ=0
  1.  F  D GETMNE D:$D(APCDEQX) CHKEHR2^APCDVCHK I APCDMPQ Q
  1.  I $G(APCDVSIT) D EP^APCDKDE
  1.  D GETMNEK
  1.  K APCDMPQ,APCDREGU
  1.  W !
  1.  Q
  1.  ;
  1. GETMNE ; GET MNEMONIC
  1.  W !
  1.  K DIC,I,D,%D,X,Y,DIADD,DLAYGO
  1.  S DIC="^APCDTKW(",DIC(0)="AEMQ",DIC("A")="MNEMONIC: ",DIC("S")="I $L($P(^APCDTKW(+Y,0),U))<5" D ^DIC K DIC("A"),DIC("S")
  1.  I Y<0 D CHECK Q
  1.  S APCDMNE=+Y,APCDMNE("NAME")=$P(Y,U,2)
  1.  K APCDMOD
  1.  D ^APCDEA3
  1.  I $D(APCDEQX) D ^APCDEQX I $D(APCDEQX) S APCDMPQ=1 Q
  1.  I $D(APCDMOD) W !!,"Switching to Modify Mode for ONE Mnemonic ONLY!" S APCDMODE="M",APCDVSIT=APCDLVST,APCDVLK=APCDVSIT D GETMNE K APCDVLK,APCDMOD S APCDMODE="A" W !!,"Switching back to ENTER Mode!" Q
  1.  Q
  1.  ;
  1. GETMNEK ; KILL GETMNE SPECIFIC VARIABLES
  1.  K APCDVSIT,APCDX,APCDEQX,APCDREGU
  1.  Q
  1.  ;
  1. CHECK ; SEE IF PV AND PRO ENTERED CORRECTLY
  1.  Q:$D(APCDMOD)
  1.  S APCDMPQ=1
  1.  K APCDNOCL D ^APCDVCHK
  1.  Q:"EX"[$P(^AUPNVSIT(APCDVSIT,0),U,7)
  1.  I APCDMODE'="M",'$D(^AUPNVPOV("AD",APCDVSIT)),'$D(^AUPNVPRN("AD",APCDVSIT)) W !,"PV mnemonic required!",!,APCDBEEP S:'$D(DTOUT) APCDMPQ=0 Q
  1.  I APCDMODE'="M",'$D(^AUPNVPRV("AD",APCDVSIT)) W !,"PRV mnemonic required!",!,APCDBEEP S:'$D(DTOUT) APCDMPQ=0 Q
  1.  I APCDMODE'="M",$D(APCDNOCL) W !,"CL mnemonic required!",!,$C(7) S:'$D(DTOUT) APCDMPQ=0 K APCDNOCL Q
  1.  I APCDMODE'="M",$P(^AUPNVSIT(APCDVSIT,0),U,7)="H",$P(^(0),U,3)'="C",'$D(^AUPNVINP("AD",APCDVSIT)) W !,"IP Mnemonic required on Hospitalizations!",$C(7) S:'$D(DTOUT) APCDMPQ=0 Q
  1.  I APCDMODE'="M",$P(^AUPNVSIT(APCDVSIT,0),U,3)="C",'$D(^AUPNVCHS("AD",APCDVSIT)) W !,"CHA, CHH or CHI mnemonic required with Contract Visits!",$C(7) S:'$D(DTOUT) APCDMPQ=0 Q
  1.  Q:'APCDMPQ
  1.  D DEDT(APCDLVST) I $P(APCDPARM,U,5)="Y",'$D(^APCDFORM("AB",APCDLVST)) S APCDFV=APCDLVST D ^APCDFORM K APCDFV
  1.  I $P(APCDPARM,U,5)="Y",$D(^AUPNVTC("AD",APCDVSIT)) S APCDFV=APCDVSIT D ^APCDFCTC K APCDFV ;IHS/CMI/LAB - patch 2 added this line to do tc tracking
  1.  Q
  1.  ;
  1. GET1 ;
  1.  W !!
  1.  K DIC,D,I,%D
  1.  S DIC="^APCDTKW(",DIC(0)="EMQX" D ^DIC K DIC
  1.  I Y<0 W !!,$C(7),$C(7),X," Mnemonic is Missing - Notify your Supervisor!" K DIC,X Q
  1.  S APCDMNE=+Y,APCDMNE("NAME")=$P(Y,U,2)
  1.  D ^APCDEA3
  1.  Q
  1.  ;
  1. SAMEPAT ; SAME PATIENT
  1.  K DIR,DIRUT,DIROUT
  1.  S APCDX=+^AUPNVSIT(APCDLVST,0),APCDX=$E(APCDX,4,5)_"-"_$E(APCDX,6,7)_"-"_(1700+$E(APCDX,1,3))_$S($P(APCDX,".",2)]"":"@"_$P(APCDX,".",2),1:"")
  1.  W !!,"You have reselected the same patient.",!
  1.  W !,"Last VISIT is ",APCDX,!
  1.  S DIR("A")="Choose",DIR(0)="S^1:Modify last VISIT;2:Append to last VISIT;3:Create new VISIT;4:Quit"
  1.  D ^DIR
  1.  S APCDX=+Y
  1.  I $D(DIRUT) S APCDX=4
  1.  K DIR,DIRUT,DIROUT,DUOUT,DTOUT
  1.  D @("SAMEPAT"_APCDX)
  1.  Q
  1. SAMEPAT1 ;
  1.  W "  Switching to Modify Mode."
  1.  S APCDMODE="M",APCDVSIT=APCDLVST,APCDVLK=APCDVSIT D MNEPROC S APCDMODE="A",APCDX=2 K APCDVLK
  1.  W !!,"Returning to Enter Mode.",!
  1.  Q
  1. SAMEPAT2 ;
  1.  W "  Switching to Append Mode."
  1.  S APCDVSIT=APCDLVST,APCDX=1,APCDAPP=1
  1.  Q
  1. SAMEPAT3 ;
  1.  W "  Creating new VISIT, still in Add Mode."
  1.  S APCDX=3,APCDADD=1
  1.  Q
  1. SAMEPAT4 ;
  1.  W "  Quit",!
  1.  S APCDX=2
  1.  Q
  1.  ;
  1. DEDT(VISIT) ;EP - update 1105 of visit
  1.  I '$G(VISIT) Q
  1.  I '$D(^AUPNVSIT(VISIT)) Q
  1.  Q:$P($G(^AUPNVSIT(VISIT,11)),U,5)]""
  1.  D ^XBFMK
  1.  S DA=VISIT,DIE="^AUPNVSIT(",DR="1105////"_DT D ^DIE
  1.  D ^XBFMK
  1.  Q