AMHEYC ; IHS/CMI/LAB - MAIN DRIVER FOR PCC EXPORT RECORD CHECK ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;
;
START ;
D INFORM
S AMH("QFLG")=0
D GETLOG^AMHEYDI2
I AMH("QFLG") G EOJ
CURRUN ;EP - COMPUTE DATES FOR CURRENT RUN
S AMHBD=""
I AMH("LAST LOG") S X1=$P(^AMHXLOG(AMH("LAST LOG"),0),U,2),X2=1 D C^%DTC S AMHBD=X,Y=X D DD^%DT
I AMHBD="" D FIRSTRUN
Q:AMH("QFLG")
S Y=DT
I Y<AMHBD W !!," Ending date cannot be before beginning date!",$C(7) S AMH("QFLG")=18 Q
S AMHED=Y
S Y=AMHBD X ^DD("DD") S AMH("X")=Y
S Y=AMHED X ^DD("DD") S AMH("Y")=Y
W !!,"This report will review records that were posted between ",AMH("X"),!," and ",AMH("Y"),", inclusive."
K %,%H,%I,AMH("RDFN"),AMH("X"),AMH("Y"),AMH("LAST LOG"),AMH("LAST BEGIN"),AMH("Z"),AMH("DATE")
;
W !! S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="Y" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) EOJ
I 'Y W !!,"okay, bye." G EOJ
ZIS ;
S XBRP="^AMHEYCP",XBRC="^AMHEYC1",XBRX="EOJ^AMHEYC",XBNS="AMH"
D ^XBDBQUE
D EOJ
Q
FIRSTRUN ; FIRST RUN EVER (NO LOG ENTRY)
FRLP ;
S DIR(0)="D^:DT:EP",DIR("A")="Enter Beginning Posting Date to review records" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) S AMH("QFLG")=99 Q
S AMHBD=Y
S AMH("FIRST RUN")=1
Q
;
EOJ ;
K AMHR,AMH,AMHBD,AMHBDD,AMHED,AMHEDD,AMHPAT,AMHPROG,AMHCAT,AMHACT,AMHHRCN,AMHSD,DFN,AMH80D,AMH80E,AMHAFF,AMHBT,AMHBTH,AMHC,AMHCOM,AMHDATE,AMHDISC,AMHDUZ2,AMHE,AMHINI,AMHJOB,AMHLOC,AMHNAME,AMHO,AMHODAT,AMHPG,AMHQUIT,AMHRCNT
K AMHREC,AMHTMP,AMHTX,AMHX,X,Y,AMHLENG,Z
K DIR,DIC,DA,D0
Q
INFORM ;
W:$D(IOF) @(IOF)
W !!,"This program will review all records that have been posted to the BH",!,"database since that last export was done. It will review all records that",!,"were posted from the day after the last date of that run up until 2 days ago.",!!
Q
AMHEYC ; IHS/CMI/LAB - MAIN DRIVER FOR PCC EXPORT RECORD CHECK ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ;
+4 ;
START ;
+1 DO INFORM
+2 SET AMH("QFLG")=0
+3 DO GETLOG^AMHEYDI2
+4 IF AMH("QFLG")
GOTO EOJ
CURRUN ;EP - COMPUTE DATES FOR CURRENT RUN
+1 SET AMHBD=""
+2 IF AMH("LAST LOG")
SET X1=$PIECE(^AMHXLOG(AMH("LAST LOG"),0),U,2)
SET X2=1
DO C^%DTC
SET AMHBD=X
SET Y=X
DO DD^%DT
+3 IF AMHBD=""
DO FIRSTRUN
+4 IF AMH("QFLG")
QUIT
+5 SET Y=DT
+6 IF Y<AMHBD
WRITE !!," Ending date cannot be before beginning date!",$CHAR(7)
SET AMH("QFLG")=18
QUIT
+7 SET AMHED=Y
+8 SET Y=AMHBD
XECUTE ^DD("DD")
SET AMH("X")=Y
+9 SET Y=AMHED
XECUTE ^DD("DD")
SET AMH("Y")=Y
+10 WRITE !!,"This report will review records that were posted between ",AMH("X"),!," and ",AMH("Y"),", inclusive."
+11 KILL %,%H,%I,AMH("RDFN"),AMH("X"),AMH("Y"),AMH("LAST LOG"),AMH("LAST BEGIN"),AMH("Z"),AMH("DATE")
+12 ;
+13 WRITE !!
SET DIR(0)="Y"
SET DIR("A")="Do you want to continue"
SET DIR("B")="Y"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+14 IF $DATA(DIRUT)
GOTO EOJ
+15 IF 'Y
WRITE !!,"okay, bye."
GOTO EOJ
ZIS ;
+1 SET XBRP="^AMHEYCP"
SET XBRC="^AMHEYC1"
SET XBRX="EOJ^AMHEYC"
SET XBNS="AMH"
+2 DO ^XBDBQUE
+3 DO EOJ
+4 QUIT
FIRSTRUN ; FIRST RUN EVER (NO LOG ENTRY)
FRLP ;
+1 SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter Beginning Posting Date to review records"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
SET AMH("QFLG")=99
QUIT
+3 SET AMHBD=Y
+4 SET AMH("FIRST RUN")=1
+5 QUIT
+6 ;
EOJ ;
+1 KILL AMHR,AMH,AMHBD,AMHBDD,AMHED,AMHEDD,AMHPAT,AMHPROG,AMHCAT,AMHACT,AMHHRCN,AMHSD,DFN,AMH80D,AMH80E,AMHAFF,AMHBT,AMHBTH,AMHC,AMHCOM,AMHDATE,AMHDISC,AMHDUZ2,AMHE,AMHINI,AMHJOB,AMHLOC,AMHNAME,AMHO,AMHODAT,AMHPG,AMHQUIT,AMHRCNT
+2 KILL AMHREC,AMHTMP,AMHTX,AMHX,X,Y,AMHLENG,Z
+3 KILL DIR,DIC,DA,D0
+4 QUIT
INFORM ;
+1 IF $DATA(IOF)
WRITE @(IOF)
+2 WRITE !!,"This program will review all records that have been posted to the BH",!,"database since that last export was done. It will review all records that",!,"were posted from the day after the last date of that run up until 2 days ago.",!!
+3 QUIT