Routine: AMHRL01

AMHRL01 ; IHS/CMI/LAB - TUCSON-OHPRD/LAB - SCREEN LOGIC ;

 ;;4.0;IHS BEHAVIORAL HEALTH;**6**;JUN 02, 2010;Build 10

INFORM ;EP

 S AMHTCW=0

 W:$D(IOF) @IOF

 I AMHPTVS="S" D SUIN

 I AMHPTVS'="S" D

 .S AMHLHDR="BEHAVIORAL HEALTH ENCOUNTER GENERAL RETRIEVAL"

 .W ?((80-$L(AMHLHDR))/2),AMHLHDR

 .W !!!,"This report will produce a listing of "_AMHPTTX_"s selected by the",!,"user.  "

 .W "The ",AMHPTTX,"s printed can be selected based on any combination of",!,"items.  The user will select these items.  The items printed on the report",!

 .W "are also selected by the user.",!!,"If selected print data items exceed 80 characters, a 132-column capacity",!,"printer will be needed.",!!

 S (AMHPCNT,AMHPTCT)=0 ;AMHPTCT -- pt total for # of "V"isits

 K AMHRDTR,AMHBDD,AMHBD,AMHEDD,AMHED

 S AMHXREF=$S(AMHPTVS="V":"C",AMHPTVS="P":"PO",1:"SU")

 K AMHTYPE ;--- just in case variable left around

 I AMHPTVS="V" D DBHUSR^AMHUTIL

 I AMHPTVS="P"!(AMHPTVS="S"),$D(^AMHBHUSR(DUZ)),$O(^AMHBHUSR(DUZ,11,0)) D

 .W !!,$G(IORVON),"Please note:",$G(IORVOFF),"  Only patients who have HRN's at the following "

 .W !?15,"locations will be included in this report:"

 .S X=0 F  S X=$O(^AMHBHUSR(DUZ,11,X)) Q:X'=+X  W !?15,$P(^DIC(4,X,0),U)

 .W !!

 .K DIR S DIR(0)="E",DIR("A")="Press return to continue" D ^DIR K DIR

SUIN ;

 W !!,"SGR Listing of Suicide Forms by Selected Variables"

 W !!,"This report is a 'general retrieval' type report and will list the"

 W !,"data items selected by the user for Suicide Forms in a date range."

 W !,"The user can also specify how to display the items in the printed"

 W !,"report.",!

ADD ;EP

 K AMHCAND

 W !!

 I $D(AMHSEAT),'$D(AMHEP1) G ADD1

 ;I AMHPTVS="S" G ADD1

 S DIR(0)="Y",DIR("A")="Do you want to use a PREVIOUSLY DEFINED REPORT",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) S AMHQUIT=1 Q

 I 'Y G ADD1

 S DIC="^AMHTRPT(",DIC("S")="I $P(^(0),U,2)&($P(^(0),U,6)=AMHPTVS)" S:$D(AMHEP1) DIC("S")=DIC("S")_"&($P(^(0),U,9)=AMHPACK)" S DIC(0)="AEQ",DIC("A")="REPORT NAME:  ",D="C" D IX^DIC K DIC,DA,DR

 I Y=-1 S AMHQUIT=1 Q

 S AMHRPT=+Y,AMHCAND=1

 ;--- set up sorting and report control variables

 S AMHSORT=$P(^AMHTRPT(AMHRPT,0),U,7),AMHSORV=$P(^(0),U,8),AMHSPAG=$P(^(0),U,4),AMHCTYP=$P(^(0),U,5)

 S X=0 F  S X=$O(^AMHTRPT(AMHRPT,12,X)) Q:X'=+X  S AMHTCW=AMHTCW+$P(^AMHTRPT(AMHRPT,12,X,0),U,2)+2

ADD1 ;

 ;CREATE REPORT ENTRY IN FILEMAN FILE

 S %H=$H D YX^%DTC S X=$P(^VA(200,DUZ,0),U)_"-"_Y,DIC(0)="L",DIC="^AMHTRPT(",DLAYGO=9002013.8,DIADD=1 D ^DIC K DIC,DA,DR,DIADD,DLAYGO I Y=-1 W !!,"UNABLE TO CREATE REPORT FILE ENTRY - NOTIFY SITE MANAGER!" S AMHQUIT=1 Q

 S AMHRPT=+Y

 K DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM

 ;DELETE ALL 11 MULTIPLE HERE

 K ^AMHTRPT(AMHRPT,11)

PAUSE ;EP

 Q:$E(IOST)'="C"!(IO'=IO(0))

 W ! S DIR(0)="EO",DIR("A")="Press enter to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1

Y ;EP - called from apclvl0

 S DIR(0)="S^1:"_AMHTEXT_";0:NO "_AMHTEXT_"",DIR("A")="Should "_$S(AMHPTVS="P":"patient",1:"visit")_" have",DIR("B")="1" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q:$D(DIRUT)

 Q:Y=""

 S ^AMHTRPT(AMHRPT,11,AMHCRIT,0)=AMHCRIT,^AMHTRPT(AMHRPT,11,"B",AMHCRIT,AMHCRIT)=""

 S ^AMHTRPT(AMHRPT,11,AMHCRIT,11,1,0)=Y,^AMHTRPT(AMHRPT,11,AMHCRIT,11,"B",Y,1)="",^AMHTRPT(AMHRPT,11,AMHCRIT,11,0)="^9001003.8110101A^"_1_"^"_1

SPECIAL ;EP

 K ^AMHTRPT(AMHRPT,11,AMHCRIT),^AMHTPRT(AMHRPT,11,"B",AMHCRIT)

 S Y="" X:$D(^AMHSORT(AMHCRIT,4)) ^(4)

 I Y="" Q

 S ^AMHTRPT(AMHRPT,11,AMHCRIT,0)=AMHCRIT,^AMHTRPT(AMHRPT,11,"B",AMHCRIT,AMHCRIT)=""

 S AMHCNT=AMHCNT+1,^AMHTRPT(AMHRPT,11,AMHCRIT,11,AMHCNT,0)=$P(Y,U),^AMHTRPT(AMHRPT,11,AMHCRIT,11,"B",$P(Y,U),AMHCNT)="",^AMHTRPT(AMHRPT,11,AMHCRIT,11,0)="^9002013.8110101A^"_AMHCNT_"^"_AMHCNT

AMHRL01   ; IHS/CMI/LAB - TUCSON-OHPRD/LAB - SCREEN LOGIC ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;**6**;JUN 02, 2010;Build 10

 +2       ;

 +3       ;

INFORM    ;EP

 +1        SET AMHTCW=0

 +2        IF $DATA(IOF)

               WRITE @IOF

 +3        IF AMHPTVS="S"

               DO SUIN

 +4        IF AMHPTVS'="S"

               Begin DoDot:1

 +5                SET AMHLHDR="BEHAVIORAL HEALTH ENCOUNTER GENERAL RETRIEVAL"

 +6                WRITE ?((80-$LENGTH(AMHLHDR))/2),AMHLHDR

 +7                WRITE !!!,"This report will produce a listing of "_AMHPTTX_"s selected by the",!,"user.  "

 +8                WRITE "The ",AMHPTTX,"s printed can be selected based on any combination of",!,"items.  The user will select these items.  The items printed on the report",!

 +9                WRITE "are also selected by the user.",!!,"If selected print data items exceed 80 characters, a 132-column capacity",!,"printer will be needed.",!!

               End DoDot:1

 +10      ;AMHPTCT -- pt total for # of "V"isits

           SET (AMHPCNT,AMHPTCT)=0

 +11       KILL AMHRDTR,AMHBDD,AMHBD,AMHEDD,AMHED

 +12       SET AMHXREF=$SELECT(AMHPTVS="V":"C",AMHPTVS="P":"PO",1:"SU")

 +13      ;--- just in case variable left around

           KILL AMHTYPE

 +14       IF AMHPTVS="V"

               DO DBHUSR^AMHUTIL

 +15       IF AMHPTVS="P"!(AMHPTVS="S")

               IF $DATA(^AMHBHUSR(DUZ))

                   IF $ORDER(^AMHBHUSR(DUZ,11,0))

                       Begin DoDot:1

 +16                       WRITE !!,$GET(IORVON),"Please note:",$GET(IORVOFF),"  Only patients who have HRN's at the following "

 +17                       WRITE !?15,"locations will be included in this report:"

 +18                       SET X=0

FOR

                               SET X=$ORDER(^AMHBHUSR(DUZ,11,X))

                               IF X'=+X

                                   QUIT

                               WRITE !?15,$PIECE(^DIC(4,X,0),U)

 +19                       WRITE !!

 +20                       KILL DIR

                           SET DIR(0)="E"

                           SET DIR("A")="Press return to continue"

                           DO ^DIR

                           KILL DIR

                       End DoDot:1

 +21       QUIT

 +22      ;

SUIN      ;

 +1        WRITE !!,"SGR Listing of Suicide Forms by Selected Variables"

 +2        WRITE !!,"This report is a 'general retrieval' type report and will list the"

 +3        WRITE !,"data items selected by the user for Suicide Forms in a date range."

 +4        WRITE !,"The user can also specify how to display the items in the printed"

 +5        WRITE !,"report.",!

 +6        QUIT

ADD       ;EP

 +1        KILL AMHCAND

 +2        WRITE !!

 +3        IF $DATA(AMHSEAT)

               IF '$DATA(AMHEP1)

                   GOTO ADD1

 +4       ;I AMHPTVS="S" G ADD1

 +5        SET DIR(0)="Y"

           SET DIR("A")="Do you want to use a PREVIOUSLY DEFINED REPORT"

           SET DIR("B")="N"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +6        IF $DATA(DIRUT)

               SET AMHQUIT=1

               QUIT

 +7        IF 'Y

               GOTO ADD1

 +8        SET DIC="^AMHTRPT("

           SET DIC("S")="I $P(^(0),U,2)&($P(^(0),U,6)=AMHPTVS)"

           IF $DATA(AMHEP1)

               SET DIC("S")=DIC("S")_"&($P(^(0),U,9)=AMHPACK)"

           SET DIC(0)="AEQ"

           SET DIC("A")="REPORT NAME:  "

           SET D="C"

           DO IX^DIC

           KILL DIC,DA,DR

 +9        IF Y=-1

               SET AMHQUIT=1

               QUIT

 +10       SET AMHRPT=+Y

           SET AMHCAND=1

 +11      ;--- set up sorting and report control variables

 +12       SET AMHSORT=$PIECE(^AMHTRPT(AMHRPT,0),U,7)

           SET AMHSORV=$PIECE(^(0),U,8)

           SET AMHSPAG=$PIECE(^(0),U,4)

           SET AMHCTYP=$PIECE(^(0),U,5)

 +13       SET X=0

FOR

               SET X=$ORDER(^AMHTRPT(AMHRPT,12,X))

               IF X'=+X

                   QUIT

               SET AMHTCW=AMHTCW+$PIECE(^AMHTRPT(AMHRPT,12,X,0),U,2)+2

 +14       QUIT

ADD1      ;

 +1       ;CREATE REPORT ENTRY IN FILEMAN FILE

 +2        SET %H=$HOROLOG

           DO YX^%DTC

           SET X=$PIECE(^VA(200,DUZ,0),U)_"-"_Y

           SET DIC(0)="L"

           SET DIC="^AMHTRPT("

           SET DLAYGO=9002013.8

           SET DIADD=1

           DO ^DIC

           KILL DIC,DA,DR,DIADD,DLAYGO

           IF Y=-1

               WRITE !!,"UNABLE TO CREATE REPORT FILE ENTRY - NOTIFY SITE MANAGER!"

               SET AMHQUIT=1

               QUIT

 +3        SET AMHRPT=+Y

 +4        KILL DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM

 +5       ;DELETE ALL 11 MULTIPLE HERE

 +6        KILL ^AMHTRPT(AMHRPT,11)

 +7        QUIT

PAUSE     ;EP

 +1        IF $EXTRACT(IOST)'="C"!(IO'=IO(0))

               QUIT

 +2        WRITE !

           SET DIR(0)="EO"

           SET DIR("A")="Press enter to continue...."

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        QUIT

Y         ;EP - called from apclvl0

 +1        SET DIR(0)="S^1:"_AMHTEXT_";0:NO "_AMHTEXT_""

           SET DIR("A")="Should "_$SELECT(AMHPTVS="P":"patient",1:"visit")_" have"

           SET DIR("B")="1"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               QUIT

 +3        IF Y=""

               QUIT

 +4        SET ^AMHTRPT(AMHRPT,11,AMHCRIT,0)=AMHCRIT

           SET ^AMHTRPT(AMHRPT,11,"B",AMHCRIT,AMHCRIT)=""

 +5        SET ^AMHTRPT(AMHRPT,11,AMHCRIT,11,1,0)=Y

           SET ^AMHTRPT(AMHRPT,11,AMHCRIT,11,"B",Y,1)=""

           SET ^AMHTRPT(AMHRPT,11,AMHCRIT,11,0)="^9001003.8110101A^"_1_"^"_1

 +6        QUIT

SPECIAL   ;EP

 +1        KILL ^AMHTRPT(AMHRPT,11,AMHCRIT),^AMHTPRT(AMHRPT,11,"B",AMHCRIT)

 +2        SET Y=""

           IF $DATA(^AMHSORT(AMHCRIT,4))

               XECUTE ^(4)

 +3        IF Y=""

               QUIT

 +4        SET ^AMHTRPT(AMHRPT,11,AMHCRIT,0)=AMHCRIT

           SET ^AMHTRPT(AMHRPT,11,"B",AMHCRIT,AMHCRIT)=""

 +5        SET AMHCNT=AMHCNT+1

           SET ^AMHTRPT(AMHRPT,11,AMHCRIT,11,AMHCNT,0)=$PIECE(Y,U)

           SET ^AMHTRPT(AMHRPT,11,AMHCRIT,11,"B",$PIECE(Y,U),AMHCNT)=""

           SET ^AMHTRPT(AMHRPT,11,AMHCRIT,11,0)="^9002013.8110101A^"_AMHCNT_"^"_AMHCNT

 +6        QUIT

AMHRL01.m