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

APCDACCR.m

Go to the documentation of this file. 
  1. APCDACCR ; IHS/CMI/LAB - remove accept command from a record ;
  1.  ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
  1.  ;
  1.  ;
  1.  D INFORM
  1.  D GETPAT
  1.  I APCDPAT="" W !!,"No PATIENT selected!" D EOJ Q
  1.  D GETVISIT
  1.  I APCDVSIT="" W !!,"No VISIT selected!" D EOJ Q
  1.  D DSPLY
  1.  D GETTYPE
  1.  I APCDPROC="" W !!,"No Record Type selected!",! D EOJ Q
  1.  D @APCDPROC
  1.  D EOJ
  1.  Q
  1.  ;
  1. INFORM ;inform user what is going on
  1.  W !!,"This option will allow you to remove the ACCEPT command in a Purpose of Visit",!,"record.  The Accept command is used to override an edit in the",!,"IHS Direct Inpatient System.",!!
  1.  W !!,"PLEASE NOTE:  The IHS Direct Inpatient System no longer requires"
  1.  W !,"the use of the ACCEPT command so this option is no longer necessary and"
  1.  W !,"will be eliminated.",!!
  1.  Q
  1.  ;
  1. EOJ ;end of job clean up
  1.  K APCDLOOK,APCDSWD,APCDSWCR,APCDSWV,APCDPAT,AUPNDAYS,AUPNPAT,AUPNSEX,AUPNDOD,AUPNDOB,X,Y,%,DR,DIE,DIC,DA,APCDVSIT,APCDCLN,APCDCAT,APCDDATE,APCDLOC,APCDTYPE,%DT,APCDPROC
  1.  Q
  1. GETTYPE ;get type of record to update
  1.  S APCDPROC=""
  1.  S DIR(0)="SO^1:Purpose of Visit (V POV);2:Procedure/Operation (V PROCEDURE);3:Inpatient Record (V HOSPITALIZATION)",DIR("A")="Remove ACCEPT Command from which of the above" D ^DIR K DIR
  1.  I $D(DIRUT) Q
  1.  S APCDPROC=Y
  1.  Q
  1.  ;
  1. GETPAT ;get patient
  1.  W !
  1.  K AUPNPAT,AUPNSEX,AUPNDAYS,AUPNDOD,AUPNDOB
  1.  S APCDPAT=""
  1.  S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC
  1.  Q:Y<0
  1.  I $D(APCDPARM),$P(APCDPARM,U,3)="Y" W !?25,"Ok" S %=1 D YN^DICN Q:%'=1
  1.  S APCDPAT=+Y
  1.  Q
  1.  ;
  1. GETVISIT ;get visit to edit
  1.  S APCDLOOK="",APCDVSIT=""
  1.  K APCDVLK
  1.  D ^APCDVLK
  1.  K APCDLOOK
  1.  Q
  1.  ;
  1. DSPLY ;display selected visit, calls APCDVDSP
  1.  S APCDVDSP=APCDVSIT D ^APCDVDSP
  1.  Q
  1.  ;
  1. 1 ;
  1.  I '$D(^AUPNVPOV("AD",APCDVSIT)) W !!,"No POV's for that Visit",! Q
  1.  W !!,"You must select which POV should have the ACCEPT command removed.",!
  1.  S APCDSWD=9000010.07,APCDSWCR="AD",APCDSWV=APCDVSIT
  1.  D ^APCDSW
  1.  I APCDLOOK="" W !!,"No POV selected!",! Q
  1.  S DA=APCDLOOK,DIE="^AUPNVPOV(",DR=".14///@" D ^DIE K DA,DIE,DR
  1.  I $D(Y) W !!,"ACCEPT COMMAND FAILED!!  NOTIFY A PROGRAMMER!" Q
  1.  W !,"Accept command has been removed for POV ",$P($$ICDDX^ICDEX($P(^AUPNVPOV(APCDLOOK,0),U)),U,2),!
  1.  D MOD
  1.  I $D(Y) W !!,"DIE FAILED... NOTIFY PROGRAMMER!"
  1.  Q
  1. 2 ;
  1.  ;
  1.  I '$D(^AUPNVPRC("AD",APCDVSIT)) W !!,"No PROCEDURE's for that Visit",! Q
  1.  W !!,"You must select which PROCEDURE/OPERATION should have the ACCEPT command removed.",!!
  1.  S APCDSWD=9000010.08,APCDSWCR="AD",APCDSWV=APCDVSIT
  1.  D ^APCDSW
  1.  I APCDLOOK="" W !!,"No PROCEDURE/OPERATION selected!",! Q
  1.  S DA=APCDLOOK,DIE="^AUPNVPRC(",DR=".09///@" D ^DIE K DA,DIE,DR
  1.  I $D(Y) W !!,"ACCEPT COMMAND FAILED!!  NOTIFY A PROGRAMMER!" Q
  1.  ;W !,"Accept command has been removed from PROCEDURE ",$P(^ICD0($P(^AUPNVPRC(APCDLOOK,0),U),0),U),!
  1.  W !,"Accept command has been removed from PROCEDURE ",$P($$ICDOP^ICDEX($P(^AUPNVPRC(APCDLOOK,0),U),$$VD^APCLV(APCDVSIT),,"I"),U,2),!
  1.  D MOD
  1.  I $D(Y) W !!,"DIE FAILED... NOTIFY PROGRAMMER",!,$C(7),$C(7)
  1.  Q
  1. 3 ;
  1.  I '$D(^AUPNVINP("AD",APCDVSIT)) W !!,"No V HOSPITALIZATION record exists for this Visit",! Q
  1.  S APCDSWD=9000010.02,APCDSWCR="AD",APCDSWV=APCDVSIT
  1.  D ^APCDSW
  1.  I APCDLOOK="" W !!,"No V HOSPITALIZATION selected!",! Q
  1.  S DA=APCDLOOK,DIE="^AUPNVINP(",DR=".14///@" D ^DIE K DA,DIE,DR
  1.  I $D(Y) W !!,"ACCEPT COMMAND FAILED!!  NOTIFY A PROGRAMMER!" Q
  1.  W !,"Accept command has been removed from V HOSPITALIZATION.",!
  1.  D MOD
  1.  I $D(Y) W !!,"DIE FAILED... NOTIFY PROGRAMMER",!,$C(7),$C(7)
  1.  Q
  1.  ;
  1. MOD ;
  1.  S AUPNVSIT=APCDVSIT D MOD^AUPNVSIT
  1.  Q