APCDACP.m

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       ;;