Routine: AMHBL

AMHBL ; IHS/CMI/LAB - backload pcc visits ;

 ;;4.0;IHS BEHAVIORAL HEALTH;**1**;JUN 18, 2010;Build 8

 ;given a date range this routine will backoad pcc visits from mhsss

EP ;

 S AMHBL=""

 W !!,"This routine will backload PCC visits from the BH package for a date",!,"range specified by the user.",!

 D ^AMHLEIN

 I 'AMHLPCC W !!,"No PCC link is active.  Check PCC Master Control file, or MHSS Site Parameter",!,"file.",!! G XIT

 I $P(^AMHSITE(DUZ(2),0),U,33)=1 W !!,"*** PLEASE TURN OFF THE INTERACTIVE PCC LINK BEFORE YOU RUN THIS ROUTINE",!,"AND THEN REMEMBER TO SET IT BACK WHEN DONE.",!

GETDATES ;

BD ;get beginning date

 W !,"Please enter the date range for which visits will be created from BH package.",!

 W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G XIT

 S AMHBD=Y

ED ;get ending date

 W ! S DIR(0)="D^"_AMHBD_":DT:EP",DIR("A")="Enter ending Date" S Y=AMHBD D DD^%DT D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G BD

 S AMHED=Y

 S X1=AMHBD,X2=-1 D C^%DTC S AMHSD=X S Y=AMHBD D DD^%DT S AMHBDD=Y S Y=AMHED D DD^%DT S AMHEDD=Y

CONT ;

 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) XIT

 I 'Y G XIT

D ; Run by encounter date

 S AMHODAT=AMHSD_".9999" F  S AMHODAT=$O(^AMHREC("B",AMHODAT)) Q:AMHODAT=""!((AMHODAT\1)>AMHED)  D D1

D1 ;

 S (AMHR,AMHRCNT)=0 F  S AMHR=$O(^AMHREC("B",AMHODAT,AMHR)) Q:AMHR'=+AMHR  I $D(^AMHREC(AMHR,0)),$P(^(0),U,2)]"",$P(^(0),U,3)]"" S AMHR0=^(0) D PROC

PROC ;

 Q:$P($G(^AMHREC(AMHR,11)),U,10)  ;EHR VISIT NO PCC LINK

 ;W "."

 S AMHPTYPE=$P(^AMHREC(AMHR,0),U,2)

 I $P(AMHR0,U,16) Q  ;already in PCC S AMHACTN=2 D PCCLINK^AMHLE2 Q

 W "."

 S AMHACTN=1 D PCCLINK^AMHLE2

XIT ;

 W !!,"ALL DONE",!

 K AMHBL,AMHR,AMHRCNT,AMHSD,AMHBD,AMHED,AMHODAT,AMHR0,AMHACTN,AMHBDD,AMHEDD,AMHLPCC

 D ^AMHEKL

AMHBL     ; IHS/CMI/LAB - backload pcc visits ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;**1**;JUN 18, 2010;Build 8

 +2       ;

 +3       ;given a date range this routine will backoad pcc visits from mhsss

 +4       ;

EP        ;

 +1        SET AMHBL=""

 +2        WRITE !!,"This routine will backload PCC visits from the BH package for a date",!,"range specified by the user.",!

 +3        DO ^AMHLEIN

 +4        IF 'AMHLPCC

               WRITE !!,"No PCC link is active.  Check PCC Master Control file, or MHSS Site Parameter",!,"file.",!!

               GOTO XIT

 +5        IF $PIECE(^AMHSITE(DUZ(2),0),U,33)=1

               WRITE !!,"*** PLEASE TURN OFF THE INTERACTIVE PCC LINK BEFORE YOU RUN THIS ROUTINE",!,"AND THEN REMEMBER TO SET IT BACK WHEN DONE.",!

GETDATES  ;

BD        ;get beginning date

 +1        WRITE !,"Please enter the date range for which visits will be created from BH package.",!

 +2        WRITE !

           SET DIR(0)="D^:DT:EP"

           SET DIR("A")="Enter beginning Date"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               GOTO XIT

 +4        SET AMHBD=Y

ED        ;get ending date

 +1        WRITE !

           SET DIR(0)="D^"_AMHBD_":DT:EP"

           SET DIR("A")="Enter ending Date"

           SET Y=AMHBD

           DO DD^%DT

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO BD

 +3        SET AMHED=Y

 +4        SET X1=AMHBD

           SET X2=-1

           DO C^%DTC

           SET AMHSD=X

           SET Y=AMHBD

           DO DD^%DT

           SET AMHBDD=Y

           SET Y=AMHED

           DO DD^%DT

           SET AMHEDD=Y

 +5       ;

CONT      ;

 +1        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

 +2        IF $DATA(DIRUT)

               GOTO XIT

 +3        IF 'Y

               GOTO XIT

D         ; Run by encounter date

 +1        SET AMHODAT=AMHSD_".9999"

FOR

               SET AMHODAT=$ORDER(^AMHREC("B",AMHODAT))

               IF AMHODAT=""!((AMHODAT\1)>AMHED)

                   QUIT

               DO D1

 +2        QUIT

 +3       ;

D1        ;

 +1        SET (AMHR,AMHRCNT)=0

FOR

               SET AMHR=$ORDER(^AMHREC("B",AMHODAT,AMHR))

               IF AMHR'=+AMHR

                   QUIT

               IF $DATA(^AMHREC(AMHR,0))

                   IF $PIECE(^(0),U,2)]""

                       IF $PIECE(^(0),U,3)]""

                           SET AMHR0=^(0)

                           DO PROC

 +2        QUIT

PROC      ;

 +1       ;EHR VISIT NO PCC LINK

           IF $PIECE($GET(^AMHREC(AMHR,11)),U,10)

               QUIT

 +2       ;W "."

 +3        SET AMHPTYPE=$PIECE(^AMHREC(AMHR,0),U,2)

 +4       ;already in PCC S AMHACTN=2 D PCCLINK^AMHLE2 Q

           IF $PIECE(AMHR0,U,16)

               QUIT

 +5        WRITE "."

 +6        SET AMHACTN=1

           DO PCCLINK^AMHLE2

 +7        QUIT

XIT       ;

 +1        WRITE !!,"ALL DONE",!

 +2        KILL AMHBL,AMHR,AMHRCNT,AMHSD,AMHBD,AMHED,AMHODAT,AMHR0,AMHACTN,AMHBDD,AMHEDD,AMHLPCC

 +3        DO ^AMHEKL

 +4        QUIT

AMHBL.m