APCDACP ; IHS/CMI/LAB - list V POV's that have Accept command ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
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
F APCDJ=1:1:6 W !,$P($T(TEXT+APCDJ),";;",2)
K APCDX,APCDJ
;
RDPV ; Determine to run by Posting date or Visit date
S APCDBEEP=$C(7)_$C(7),APCDSITE="" S:$D(DUZ(2)) APCDSITE=DUZ(2)
I APCDSITE="" S APCDSITE=+^AUTTSITE(1,0)
S DIR(0)="S^1:Posting Date;2:Visit Date",DIR("A")="Run Report by",DIR("B")="P" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G XIT
S Y=$E(Y),APCDX=$S(Y=1:"P",Y=2:"V",1:Y)
GETDATES ;
BD ;get beginning date
W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning "_$S(APCDX="P":"Posting",APCDX="V":"Visit",1:"Posting")_" Date for Search" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G XIT
S APCDBD=Y
ED ;get ending date
W ! S DIR(0)="DA^"_APCDBD_":DT:EP",DIR("A")="Enter ending "_$S(APCDX="P":"Posting",APCDX="V":"Visit",1:"Posting")_" Date for Search: " S Y=APCDBD D DD^%DT S DIR("B")=Y,Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G BD
S APCDED=Y
S X1=APCDBD,X2=-1 D C^%DTC S APCDSD=X
TYPE ;
S DIR(0)="S^1:Purpose of Visit Records;2:Operations/Procedure Records;3:V Hospitalization Records;4:All of the Above",DIR("A")="List ACCEPT commands for which of the above" D ^DIR K DIR
G:$D(DIRUT) BD
S (APCDT,APCDACCT)=+Y
DEMO ;
D DEMOCHK^APCLUTL(.APCLDEMO)
I APCLDEMO=-1 G TYPE
ZIS ;
W !! S %ZIS="PQ" D ^%ZIS
I POP G XIT
I $D(IO("Q")) G TSKMN
DRIVER ;EP;entry point from taskman
S U="^"
K ^XTMP("APCDACP",$J)
D @APCDX
U IO
S APCDDT=$$FMTE^XLFDT(DT)
D ^APCDACP1
I '$D(ZTQUEUED) U IO(0)
I $D(ZTQUEUED) S ZTREQ="@"
G XIT
P ; Run by Posting date
S APCDODAT=$O(^AUPNVSIT("AMRG",APCDSD)) Q:APCDODAT=""
S APCDVDFN=$O(^AUPNVSIT("AMRG",APCDODAT,"")) I APCDVDFN="" W !,"An error has occurred in the AMRG cross reference. Please notify your Supervisor" Q
S APCDVDFN=APCDVDFN-1
F APCDL=0:0 S APCDVDFN=$O(^AUPNVSIT(APCDVDFN)) Q:APCDVDFN'=+APCDVDFN I $D(^AUPNVSIT(APCDVDFN,0)) S APCDODAT=$P(^AUPNVSIT(APCDVDFN,0),U,2) Q:(APCDODAT>APCDED) D PROC^APCDACP2
Q
V ; Run by visit date
S APCDODAT=$O(^AUPNVSIT("B",APCDSD)) Q:APCDODAT=""
S APCDODAT=APCDSD_".9999" F APCDL=0:0 S APCDODAT=$O(^AUPNVSIT("B",APCDODAT)) Q:APCDODAT=""!((APCDODAT\1)>APCDED) D V1
Q
V1 ;
S APCDVDFN="" F APCDL=0:0 S APCDVDFN=$O(^AUPNVSIT("B",APCDODAT,APCDVDFN)) Q:APCDVDFN'=+APCDVDFN I $D(^AUPNVSIT(APCDVDFN,0)) D PROC^APCDACP2
Q
ERR W APCDBEEP,!,"Must be a valid date and be Today or earlier. Time not allowed!" Q
TSKMN ;
K ZTSAVE F %="APCDX","APCDT","APCDBD","APCDED","APCDSD","APCDBDD","APCDBEEP","APCDSITE","APCDACCT","APCDFILE","APCDG","APCDTITL" S ZTSAVE(%)=""
S ZTCPU=$G(IOCPU),ZTIO=ION,ZTRTN="DRIVER^APCDACP",ZTDTH="",ZTDESC="REVIEW ACCEPT POVS - DATA ENTRY" D ^%ZTLOAD D XIT Q
XIT K APCDBEEP,APCDX,APCDT,APCDBD,APCDED,APCDSD,APCDODAT,APCDVDFN,%,APCDL,X,X1,X2,IO("Q"),APCDDT,APCDSITE,APCDLC,APCDPG,APCDCAT,APCDTYPE,APCDADM,APCDPS,APCDPVP,APCDFILE,APCDOVAG,Y,POP,ZTSK,APCDJ
K AUPNPAT,AUPNDAYS,AUPNDOB,AUPNSEX,AUPNDOD
K APCDACCT,APCDG,APCDTITL,APCDFILE,APCDVIGR,DIRUT
D ^%ZISC
K ^XTMP("APCDACP",$J)
Q
HDR ;
;;PCC Data Entry Module
;;
;;*****************************
;;* PRINT ACCEPT Commands *
;;*****************************
;;
;
TEXT ;informing paragraph
;;
;;This option will allow you to print all of the Purpose of Visit, Procedures
;;and/or Hospitalization records that have had the ACCEPT command applied.
;;The ACCEPT command is used to override an edit in the IHS Direct Inpatient
;;and/or PCIS Systems.
;;
APCDACP ; IHS/CMI/LAB - list V POV's that have Accept command ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
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 FOR APCDJ=1:1:6
WRITE !,$PIECE($TEXT(TEXT+APCDJ),";;",2)
+4 KILL APCDX,APCDJ
+5 ;
RDPV ; Determine to run by Posting date or Visit date
+1 SET APCDBEEP=$CHAR(7)_$CHAR(7)
SET APCDSITE=""
IF $DATA(DUZ(2))
SET APCDSITE=DUZ(2)
+2 IF APCDSITE=""
SET APCDSITE=+^AUTTSITE(1,0)
+3 SET DIR(0)="S^1:Posting Date;2:Visit Date"
SET DIR("A")="Run Report by"
SET DIR("B")="P"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF $DATA(DIRUT)
GOTO XIT
+5 SET Y=$EXTRACT(Y)
SET APCDX=$SELECT(Y=1:"P",Y=2:"V",1:Y)
GETDATES ;
BD ;get beginning date
+1 WRITE !
SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter beginning "_$SELECT(APCDX="P":"Posting",APCDX="V":"Visit",1:"Posting")_" Date for Search"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO XIT
+3 SET APCDBD=Y
ED ;get ending date
+1 WRITE !
SET DIR(0)="DA^"_APCDBD_":DT:EP"
SET DIR("A")="Enter ending "_$SELECT(APCDX="P":"Posting",APCDX="V":"Visit",1:"Posting")_" Date for Search: "
SET Y=APCDBD
DO DD^%DT
SET DIR("B")=Y
SET Y=""
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO BD
+3 SET APCDED=Y
+4 SET X1=APCDBD
SET X2=-1
DO C^%DTC
SET APCDSD=X
TYPE ;
+1 SET DIR(0)="S^1:Purpose of Visit Records;2:Operations/Procedure Records;3:V Hospitalization Records;4:All of the Above"
SET DIR("A")="List ACCEPT commands for which of the above"
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
GOTO BD
+3 SET (APCDT,APCDACCT)=+Y
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCLDEMO)
+2 IF APCLDEMO=-1
GOTO TYPE
ZIS ;
+1 WRITE !!
SET %ZIS="PQ"
DO ^%ZIS
+2 IF POP
GOTO XIT
+3 IF $DATA(IO("Q"))
GOTO TSKMN
DRIVER ;EP;entry point from taskman
+1 SET U="^"
+2 KILL ^XTMP("APCDACP",$JOB)
+3 DO @APCDX
+4 USE IO
+5 SET APCDDT=$$FMTE^XLFDT(DT)
+6 DO ^APCDACP1
+7 IF '$DATA(ZTQUEUED)
USE IO(0)
+8 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+9 GOTO XIT
P ; Run by Posting date
+1 SET APCDODAT=$ORDER(^AUPNVSIT("AMRG",APCDSD))
IF APCDODAT=""
QUIT
+2 SET APCDVDFN=$ORDER(^AUPNVSIT("AMRG",APCDODAT,""))
IF APCDVDFN=""
WRITE !,"An error has occurred in the AMRG cross reference. Please notify your Supervisor"
QUIT
+3 SET APCDVDFN=APCDVDFN-1
+4 FOR APCDL=0:0
SET APCDVDFN=$ORDER(^AUPNVSIT(APCDVDFN))
IF APCDVDFN'=+APCDVDFN
QUIT
IF $DATA(^AUPNVSIT(APCDVDFN,0))
SET APCDODAT=$PIECE(^AUPNVSIT(APCDVDFN,0),U,2)
IF (APCDODAT>APCDED)
QUIT
DO PROC^APCDACP2
+5 QUIT
V ; Run by visit date
+1 SET APCDODAT=$ORDER(^AUPNVSIT("B",APCDSD))
IF APCDODAT=""
QUIT
+2 SET APCDODAT=APCDSD_".9999"
FOR APCDL=0:0
SET APCDODAT=$ORDER(^AUPNVSIT("B",APCDODAT))
IF APCDODAT=""!((APCDODAT\1)>APCDED)
QUIT
DO V1
+3 QUIT
V1 ;
+1 SET APCDVDFN=""
FOR APCDL=0:0
SET APCDVDFN=$ORDER(^AUPNVSIT("B",APCDODAT,APCDVDFN))
IF APCDVDFN'=+APCDVDFN
QUIT
IF $DATA(^AUPNVSIT(APCDVDFN,0))
DO PROC^APCDACP2
+2 QUIT
ERR WRITE APCDBEEP,!,"Must be a valid date and be Today or earlier. Time not allowed!"
QUIT
TSKMN ;
+1 KILL ZTSAVE
FOR %="APCDX","APCDT","APCDBD","APCDED","APCDSD","APCDBDD","APCDBEEP","APCDSITE","APCDACCT","APCDFILE","APCDG","APCDTITL"
SET ZTSAVE(%)=""
+2 SET ZTCPU=$GET(IOCPU)
SET ZTIO=ION
SET ZTRTN="DRIVER^APCDACP"
SET ZTDTH=""
SET ZTDESC="REVIEW ACCEPT POVS - DATA ENTRY"
DO ^%ZTLOAD
DO XIT
QUIT
XIT KILL APCDBEEP,APCDX,APCDT,APCDBD,APCDED,APCDSD,APCDODAT,APCDVDFN,%,APCDL,X,X1,X2,IO("Q"),APCDDT,APCDSITE,APCDLC,APCDPG,APCDCAT,APCDTYPE,APCDADM,APCDPS,APCDPVP,APCDFILE,APCDOVAG,Y,POP,ZTSK,APCDJ
+1 KILL AUPNPAT,AUPNDAYS,AUPNDOB,AUPNSEX,AUPNDOD
+2 KILL APCDACCT,APCDG,APCDTITL,APCDFILE,APCDVIGR,DIRUT
+3 DO ^%ZISC
+4 KILL ^XTMP("APCDACP",$JOB)
+5 QUIT
HDR ;
+1 ;;PCC Data Entry Module
+2 ;;
+3 ;;*****************************
+4 ;;* PRINT ACCEPT Commands *
+5 ;;*****************************
+6 ;;
+7 ;
TEXT ;informing paragraph
+1 ;;
+2 ;;This option will allow you to print all of the Purpose of Visit, Procedures
+3 ;;and/or Hospitalization records that have had the ACCEPT command applied.
+4 ;;The ACCEPT command is used to override an edit in the IHS Direct Inpatient
+5 ;;and/or PCIS Systems.
+6 ;;
