AMHRSTMP.m

AMHRSTMP ; IHS/CMI/LAB - CREATE SEARCH TEMPLATE FOR REPORTS ;

 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 ;

EN ;EP - ENTRY POINT

 D EN1

EXIT K AMHRSDIC,AMHRSNAM,AMHRSTN,DHD

 Q

EN1 ;EP Help

 K AMHRQUIT

 W !

 W ?10,"*** You may enter an existing Template Name ***",! W ?30,"OR",! W ?12,"*** Save results in a  New Template ***",! W ?30,"OR",! W ?25,"'^' to Exit",!!

EN2 K DIC,DLAYGO S DLAYGO=.401,DIC="^DIBT(",DIC(0)="AELMQZ",DIC("A")="Patient Search Template: ",DIC("S")="I $P(^(0),U,4)=9000001&($P(^(0),U,5)=DUZ)"

 W !

 D ^DIC K DIC,DLAYGO

 I +Y<1 W !!,"No Search Template selected." H 2 S AMHRQUIT=1 Q

 S AMHRSTMP=+Y,AMHRSNAM=$P(^DIBT(AMHRSTMP,0),U)

DUP I '$P(Y,U,3) D  I Q K AMHRSTMP,Y G EN2

 .S Q=""

 .W !!,$C(7),$C(7)

 .S DIR(0)="Y",DIR("A")="That template already exists!!  Do you want to overwrite it",DIR("B")="N" K DA D ^DIR K DIR

 .I $D(DIRUT) S Q=1 Q

 .I 'Y S Q=1 Q

 .L +^DIBT(AMHRSTMP):10

 .S AMHRSTN=$P(^DIBT(AMHRSTMP,0),U) S DA=AMHRSTMP,DIK="^DIBT(" D ^DIK

 .S ^DIBT(AMHRSTMP,0)=AMHRSNAM,DA=AMHRSTMP,DIK="^DIBT(" D IX1^DIK

 .L -^DIBT(AMHRSTMP)

 .Q

 I AMHRSTMP,$D(^DIBT(AMHRSTMP)) D

 .W !!,?5,"An unduplicated PATIENT list resulting from this report",!,?5,"will be stored in the.........>",!!?18,"**  ",AMHRSNAM,"  ** Search Template."

 .K ^DIBT(AMHRSTMP,1)

 .S DHIT="S ^DIBT("_AMHRSTMP_",1,DFN)="""""

 .S DIE="^DIBT(",DA=AMHRSTMP,DR="2////"_DT_";3////M;4////9000001;5////"_DUZ_";6////M"

 .D ^DIE

 .K DIE,DA,DR

 Q

AMHRSTMP  ; IHS/CMI/LAB - CREATE SEARCH TEMPLATE FOR REPORTS ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 +2       ;

EN        ;EP - ENTRY POINT

 +1        DO EN1

EXIT       KILL AMHRSDIC,AMHRSNAM,AMHRSTN,DHD

 +1        QUIT 

EN1       ;EP Help

 +1        KILL AMHRQUIT

 +2        WRITE !

 +3        WRITE ?10,"*** You may enter an existing Template Name ***",!

           WRITE ?30,"OR",!

           WRITE ?12,"*** Save results in a  New Template ***",!

           WRITE ?30,"OR",!

           WRITE ?25,"'^' to Exit",!!

EN2        KILL DIC,DLAYGO

           SET DLAYGO=.401

           SET DIC="^DIBT("

           SET DIC(0)="AELMQZ"

           SET DIC("A")="Patient Search Template: "

           SET DIC("S")="I $P(^(0),U,4)=9000001&($P(^(0),U,5)=DUZ)"

 +1        WRITE !

 +2        DO ^DIC

           KILL DIC,DLAYGO

 +3        IF +Y<1

               WRITE !!,"No Search Template selected."

               HANG 2

               SET AMHRQUIT=1

               QUIT 

 +4        SET AMHRSTMP=+Y

           SET AMHRSNAM=$PIECE(^DIBT(AMHRSTMP,0),U)

DUP        IF '$PIECE(Y,U,3)

               Begin DoDot:1

 +1                SET Q=""

 +2                WRITE !!,$CHAR(7),$CHAR(7)

 +3                SET DIR(0)="Y"

                   SET DIR("A")="That template already exists!!  Do you want to overwrite it"

                   SET DIR("B")="N"

                   KILL DA

                   DO ^DIR

                   KILL DIR

 +4                IF $DATA(DIRUT)

                       SET Q=1

                       QUIT 

 +5                IF 'Y

                       SET Q=1

                       QUIT 

 +6                LOCK +^DIBT(AMHRSTMP):10

 +7                SET AMHRSTN=$PIECE(^DIBT(AMHRSTMP,0),U)

                   SET DA=AMHRSTMP

                   SET DIK="^DIBT("

                   DO ^DIK

 +8                SET ^DIBT(AMHRSTMP,0)=AMHRSNAM

                   SET DA=AMHRSTMP

                   SET DIK="^DIBT("

                   DO IX1^DIK

 +9                LOCK -^DIBT(AMHRSTMP)

 +10               QUIT 

               End DoDot:1

               IF Q

                   KILL AMHRSTMP,Y

                   GOTO EN2

 +11       IF AMHRSTMP

               IF $DATA(^DIBT(AMHRSTMP))

                   Begin DoDot:1

 +12                   WRITE !!,?5,"An unduplicated PATIENT list resulting from this report",!,?5,"will be stored in the.........>",!!?18,"**  ",AMHRSNAM,"  ** Search Template."

 +13                   KILL ^DIBT(AMHRSTMP,1)

 +14                   SET DHIT="S ^DIBT("_AMHRSTMP_",1,DFN)="""""

 +15                   SET DIE="^DIBT("

                       SET DA=AMHRSTMP

                       SET DR="2////"_DT_";3////M;4////9000001;5////"_DUZ_";6////M"

 +16                   DO ^DIE

 +17                   KILL DIE,DA,DR

                   End DoDot:1

 +18       QUIT