APCDACC ; IHS/CMI/LAB - stuff accept command on pov record ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
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
MORE D GETTYPE
I APCDPROC="" W !!,"No Record Type selected!",! D EOJ Q
D @APCDPROC
D PROCESS
D MORE
D EOJ
Q
;
INFORM ; inform user what is going on
W:$D(IOF) @IOF
F APCDJ=1:1:5 S APCDX=$P($T(HDR+APCDJ),";;",2) W !?80-$L(APCDX)\2,APCDX
K APCDX,APCDJ
F APCDJ=1:1:5 W !,$P($T(TEXT+APCDJ),";;",2)
Q
;
EOJ ; eoj clean up
K ^UTILITY("DIQ1",$J)
K APCDLOOK,APCDN,APCDCR,APCDVSIT,APCDPAT,APCDVSIT,APCDCLN,APCDCAT,APCDDATE,APCDLOC,APCDTYPE,APCDACCT,APCDPROC,APCDJ,APCDFN,APCDG,APCDT,APCDVIGR,APCDY
K X,Y,%,DR,DIE,DIC,DA,%DT,D,DX,POP,S,DA,D0,DQ,DI,A
K AUPNPAT,AUPNSEX,AUPNDOB,AUPNDOD,AUPNDAYS
Q
GETTYPE ;get type of record to edit
S APCDPROC=""
S DIR(0)="SO^1:Purpose of Visit (V POV);2:Procedure/Operation (V PROCEDURE);3:Inpatient Record (V HOSPITALIZATION)",DIR("A")="Enter ACCEPT Command for which of the above" D ^DIR K DIR
Q:$D(DIRUT)
S APCDPROC=Y
Q
;
GETPAT ;get patient
K AUPNPAT,AUPNSEX,AUPNDAYS,AUPNDOD,AUPNDOB
S APCDPAT="",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 VISIT TO BE EDITED
S APCDVDSP=APCDVSIT D ^APCDVDSP
Q
SET ;the following sub-routines set up variables with file
;specific information for each item in the GETTYPE DIR call
1 ;
S APCDG="^AUPNVPOV(",APCDT="Purpose of Visit (V POV)",APCDN=9000010.07,APCDFN=".14"
Q
;
2 ;
S APCDG="^AUPNVPRC(",APCDT="Procedure/Operation (V Procedure)",APCDN=9000010.08,APCDFN=".09"
Q
;
3 ;
S APCDG="^AUPNVINP(",APCDT="Inpatient Record (V HOSPITALIZATION)",APCDN=9000010.02,APCDFN=".14"
Q
PROCESS ;process the ACCEPT command
S APCDVIGR=APCDG_"""AD"",APCDVSIT)"
I '$D(@APCDVIGR) W !!!,$C(7),"No ",APCDT,"'s for that Visit.",! Q
W !!,"You must select which ",APCDT," should be given",!,"the ACCEPT command."
S APCDSWCR="AD",APCDSWV=APCDVSIT,APCDSWD=APCDN
D ^APCDSW
I '$D(APCDLOOK) W !!,"No ",APCDT," selected!",! Q
I APCDLOOK="" W !!,"No ",APCDT," selected!",! Q
S DA=APCDLOOK,DIE=APCDG,DR=APCDFN_"////^S X=DUZ" D ^DIE K DA,DIE,DR,DIU,DIV
I $D(Y) W !!,"ACCEPT COMMAND FAILED!! NOTIFY A PROGRAMMER!",$C(7),$C(7) Q
K ^UTILITY("DIQ1",$J) S DIC=APCDG,DR=".01",DA=APCDLOOK D EN^DIQ1
W !,"Accept command has been set for ",APCDT," ",^UTILITY("DIQ1",$J,APCDN,APCDLOOK,".01"),".",!
S AUPNVSIT=APCDVSIT D MOD^AUPNVSIT
I $D(Y) W !!,"DIE FAILED... NOTIFY PROGRAMMER",!,$C(7),$C(7)
Q
HDR ;
;;PCC Data Entry Module
;;
;;****************************
;;* ACCEPT Command Entry *
;;****************************
;;
;
TEXT ;informing paragraph
;;
;;PLEASE NOTE: THE ACCEPT COMMAND IS NO LONGER NECESSARY TO BE ENTERED
;;TO OVERRIDE AN EDIT. THIS OPTION WILL BE ELIMINATED IN A FUTURE PATCH.
;;VISITS WILL EXPORT TO THE DATA WAREHOUSE AND WILL NOT BE REJECTED IF
;;THE ACCEPT COMMAND IS NOT PRESENT.
;;
;;This option will allow you to set the ACCEPT command in a Purpose of Visit,
;;Procedure or Hospitalization record. This ACCEPT command is used to
;;override an edit in the IHS Direct Inpatient and/or PCIS Systems.
;;
APCDACC ; IHS/CMI/LAB - stuff accept command on pov record ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
+3 DO INFORM
+4 DO GETPAT
+5 IF APCDPAT=""
WRITE !!,"No PATIENT selected!"
DO EOJ
QUIT
+6 DO GETVISIT
+7 IF APCDVSIT=""
WRITE !!,"No VISIT selected!"
DO EOJ
QUIT
+8 DO DSPLY
MORE DO GETTYPE
+1 IF APCDPROC=""
WRITE !!,"No Record Type selected!",!
DO EOJ
QUIT
+2 DO @APCDPROC
+3 DO PROCESS
+4 DO MORE
+5 DO EOJ
+6 QUIT
+7 ;
INFORM ; inform user what is going on
+1 IF $DATA(IOF)
WRITE @IOF
+2 FOR APCDJ=1:1:5
SET APCDX=$PIECE($TEXT(HDR+APCDJ),";;",2)
WRITE !?80-$LENGTH(APCDX)\2,APCDX
+3 KILL APCDX,APCDJ
+4 FOR APCDJ=1:1:5
WRITE !,$PIECE($TEXT(TEXT+APCDJ),";;",2)
+5 QUIT
+6 ;
EOJ ; eoj clean up
+1 KILL ^UTILITY("DIQ1",$JOB)
+2 KILL APCDLOOK,APCDN,APCDCR,APCDVSIT,APCDPAT,APCDVSIT,APCDCLN,APCDCAT,APCDDATE,APCDLOC,APCDTYPE,APCDACCT,APCDPROC,APCDJ,APCDFN,APCDG,APCDT,APCDVIGR,APCDY
+3 KILL X,Y,%,DR,DIE,DIC,DA,%DT,D,DX,POP,S,DA,D0,DQ,DI,A
+4 KILL AUPNPAT,AUPNSEX,AUPNDOB,AUPNDOD,AUPNDAYS
+5 QUIT
GETTYPE ;get type of record to edit
+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")="Enter ACCEPT Command for which of the above"
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
QUIT
+4 SET APCDPROC=Y
+5 QUIT
+6 ;
GETPAT ;get patient
+1 KILL AUPNPAT,AUPNSEX,AUPNDAYS,AUPNDOD,AUPNDOB
+2 SET APCDPAT=""
SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+3 IF Y<0
QUIT
+4 IF $DATA(APCDPARM)
IF $PIECE(APCDPARM,U,3)="Y"
WRITE !?25,"Ok"
SET %=1
DO YN^DICN
IF %'=1
QUIT
+5 SET APCDPAT=+Y
+6 QUIT
+7 ;
GETVISIT ;get visit to edit
+1 SET (APCDLOOK,APCDVSIT)=""
+2 KILL APCDVLK
+3 DO ^APCDVLK
+4 KILL APCDLOOK
+5 QUIT
+6 ;
DSPLY ; DISPLAY VISIT TO BE EDITED
+1 SET APCDVDSP=APCDVSIT
DO ^APCDVDSP
+2 QUIT
SET ;the following sub-routines set up variables with file
+1 ;specific information for each item in the GETTYPE DIR call
1 ;
+1 SET APCDG="^AUPNVPOV("
SET APCDT="Purpose of Visit (V POV)"
SET APCDN=9000010.07
SET APCDFN=".14"
+2 QUIT
+3 ;
2 ;
+1 SET APCDG="^AUPNVPRC("
SET APCDT="Procedure/Operation (V Procedure)"
SET APCDN=9000010.08
SET APCDFN=".09"
+2 QUIT
+3 ;
3 ;
+1 SET APCDG="^AUPNVINP("
SET APCDT="Inpatient Record (V HOSPITALIZATION)"
SET APCDN=9000010.02
SET APCDFN=".14"
+2 QUIT
PROCESS ;process the ACCEPT command
+1 SET APCDVIGR=APCDG_"""AD"",APCDVSIT)"
+2 IF '$DATA(@APCDVIGR)
WRITE !!!,$CHAR(7),"No ",APCDT,"'s for that Visit.",!
QUIT
+3 WRITE !!,"You must select which ",APCDT," should be given",!,"the ACCEPT command."
+4 SET APCDSWCR="AD"
SET APCDSWV=APCDVSIT
SET APCDSWD=APCDN
+5 DO ^APCDSW
+6 IF '$DATA(APCDLOOK)
WRITE !!,"No ",APCDT," selected!",!
QUIT
+7 IF APCDLOOK=""
WRITE !!,"No ",APCDT," selected!",!
QUIT
+8 SET DA=APCDLOOK
SET DIE=APCDG
SET DR=APCDFN_"////^S X=DUZ"
DO ^DIE
KILL DA,DIE,DR,DIU,DIV
+9 IF $DATA(Y)
WRITE !!,"ACCEPT COMMAND FAILED!! NOTIFY A PROGRAMMER!",$CHAR(7),$CHAR(7)
QUIT
+10 KILL ^UTILITY("DIQ1",$JOB)
SET DIC=APCDG
SET DR=".01"
SET DA=APCDLOOK
DO EN^DIQ1
+11 WRITE !,"Accept command has been set for ",APCDT," ",^UTILITY("DIQ1",$JOB,APCDN,APCDLOOK,".01"),".",!
+12 SET AUPNVSIT=APCDVSIT
DO MOD^AUPNVSIT
+13 IF $DATA(Y)
WRITE !!,"DIE FAILED... NOTIFY PROGRAMMER",!,$CHAR(7),$CHAR(7)
+14 QUIT
HDR ;
+1 ;;PCC Data Entry Module
+2 ;;
+3 ;;****************************
+4 ;;* ACCEPT Command Entry *
+5 ;;****************************
+6 ;;
+7 ;
TEXT ;informing paragraph
+1 ;;
+2 ;;PLEASE NOTE: THE ACCEPT COMMAND IS NO LONGER NECESSARY TO BE ENTERED
+3 ;;TO OVERRIDE AN EDIT. THIS OPTION WILL BE ELIMINATED IN A FUTURE PATCH.
+4 ;;VISITS WILL EXPORT TO THE DATA WAREHOUSE AND WILL NOT BE REJECTED IF
+5 ;;THE ACCEPT COMMAND IS NOT PRESENT.
+6 ;;
+7 ;;This option will allow you to set the ACCEPT command in a Purpose of Visit,
+8 ;;Procedure or Hospitalization record. This ACCEPT command is used to
+9 ;;override an edit in the IHS Direct Inpatient and/or PCIS Systems.
+10 ;;
