Routine: ACMSTMP

ACMSTMP ; IHS/TUCSON/TMJ - CREATE SEARCH TEMPLATE FOR CMS REPORTS ;

 ;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996

 ;;Routine added for Patch 2

 ;EP;ENTRY POINT

EN D EN1

EXIT K ACMSDIC,ACMSNAM,ACMSTN,DHD

EN1 S DIR(0)="YO",DIR("A")="Store Report Result as Search Template",DIR("B")="NO"

W !

 D ^DIR

 K DIR

 Q:Y'=1

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

W !

 D ^DIC

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

 S ACMSTMP=+Y,ACMSNAM=$P(^DIBT(ACMSTMP,0),U)

DUP I '$P(Y,U,3) D  I Q K ACMSTMP,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(ACMSTMP):10

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

 .S ^DIBT(ACMSTMP,0)=ACMSNAM,DA=ACMSTMP,DIK="^DIBT(" D IX1^DIK

 .L -^DIBT(ACMSTMP)

.Q

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

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

 .K ^DIBT(ACMSTMP,1)

 .S DHIT="S ^DIBT("_ACMSTMP_",1,$P("_ACMDIC_"D0,0),U,2))="""""

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

 .D ^DIE

 .K DIE,DA,DR

;Q

 ;Run Template in Background Mode

BACK ;

 S DHD="W ?0 D HDR^ACMSTMP",FLDS="!.01"

 W !!,"A brief report will be printed after the search template is complete.",!,"You must enter a device for this report OR you may queue at this time.",!

HDR ;

 W !!,?15,"***CASE MANAGEMENT SYSTEM, SEARCH TEMPLATE CREATION***"

 W !!,?1,"Template Created: ",$P(^DIBT(ACMSTMP,0),U)

 W !,?1,"Created by:  ",$P(^VA(200,DUZ,0),U)

 W !,"------------------------------------------------------------------------------",!

ACMSTMP   ; IHS/TUCSON/TMJ - CREATE SEARCH TEMPLATE FOR CMS REPORTS ;

 +1       ;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996

 +2       ;;Routine added for Patch 2

 +3       ;EP;ENTRY POINT

EN         DO EN1

EXIT       KILL ACMSDIC,ACMSNAM,ACMSTN,DHD

 +1        QUIT

EN1        SET DIR(0)="YO"

           SET DIR("A")="Store Report Result as Search Template"

           SET DIR("B")="NO"

 +1        WRITE !

 +2        DO ^DIR

 +3        KILL DIR

 +4        IF Y'=1

               QUIT

EN2        SET DIC="^DIBT("

           SET DIC(0)="AELMQZ"

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

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

 +1        WRITE !

 +2        DO ^DIC

 +3        IF +Y<1

               WRITE !!,"No Search Template selected."

               HANG 2

               QUIT

 +4        SET ACMSTMP=+Y

           SET ACMSNAM=$PIECE(^DIBT(ACMSTMP,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(ACMSTMP):10

 +7                SET ACMSTN=$PIECE(^DIBT(ACMSTMP,0),U)

                   SET DA=ACMSTMP

                   SET DIK="^DIBT("

                   DO ^DIK

 +8                SET ^DIBT(ACMSTMP,0)=ACMSNAM

                   SET DA=ACMSTMP

                   SET DIK="^DIBT("

                   DO IX1^DIK

 +9                LOCK -^DIBT(ACMSTMP)

 +10               QUIT

               End DoDot:1

               IF Q

                   KILL ACMSTMP,Y

                   GOTO EN2

 +11       IF ACMSTMP

               IF $DATA(^DIBT(ACMSTMP))

                   Begin DoDot:1

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

 +13                   KILL ^DIBT(ACMSTMP,1)

 +14                   SET DHIT="S ^DIBT("_ACMSTMP_",1,$P("_ACMDIC_"D0,0),U,2))="""""

 +15                   SET DIE="^DIBT("

                       SET DA=ACMSTMP

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

 +16                   DO ^DIE

 +17                   KILL DIE,DA,DR

                   End DoDot:1

 +18      ;Q

 +19      ;Run Template in Background Mode

 +20      ;

BACK      ;

 +1        SET DHD="W ?0 D HDR^ACMSTMP"

           SET FLDS="!.01"

 +2        WRITE !!,"A brief report will be printed after the search template is complete.",!,"You must enter a device for this report OR you may queue at this time.",!

 +3        QUIT

HDR       ;

 +1        WRITE !!,?15,"***CASE MANAGEMENT SYSTEM, SEARCH TEMPLATE CREATION***"

 +2        WRITE !!,?1,"Template Created: ",$PIECE(^DIBT(ACMSTMP,0),U)

 +3        WRITE !,?1,"Created by:  ",$PIECE(^VA(200,DUZ,0),U)

 +4        WRITE !,"------------------------------------------------------------------------------",!

 +5        QUIT

ACMSTMP.m