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