APCLSTMV.m

APCLSTMV ; IHS/CMI/LAB - CREATE SEARCH TEMPLATE FOR VGEN (VISITS) REPORTS ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;

EN ;EP - ENTRY POINT

 D EN1

EXIT K APCLSDIC,APCLSNAM,APCLSTN,DHD

 Q

EN1 ;EP Help Text

 K APCLQUIT

 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")="Visit Search Template: ",DIC("S")="I $P(^(0),U,4)=9000010&($P(^(0),U,5)=DUZ)"

 W !

 D ^DIC K DLAYGO,DIC

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

 S APCLSTMP=+Y,APCLSNAM=$P(^DIBT(APCLSTMP,0),U)

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

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

 .S ^DIBT(APCLSTMP,0)=APCLSNAM,DA=APCLSTMP,DIK="^DIBT(" D IX1^DIK

 .L -^DIBT(APCLSTMP)

 .Q

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

 .W !!,?5,"A VISIT list resulting from this report",!,?5,"will be stored in the.........>",!!?18,"**  ",APCLSNAM,"  ** Search Template."

 .K ^DIBT(APCLSTMP,1)

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

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

 .D ^DIE

 .K DIE,DA,DR

 ;Q

 ;Run Template in Background Mode

 ;

 ;

 Q

 ;

SETRECS ;EP - Set Entries into Template

 ;

 S APCLSRTV=""

 F  S APCLSRTV=$O(^XTMP("APCLVL",APCLJOB,APCLBTH,"DATA HITS",APCLSRTV)) Q:APCLSRTV=""  D NEXT

 Q

 ;

NEXT ;2ND $ORDER

 S APCLVDFN=0 F  S APCLVDFN=$O(^XTMP("APCLVL",APCLJOB,APCLBTH,"DATA HITS",APCLSRTV,APCLVDFN)) Q:APCLVDFN'=+APCLVDFN  D

 .S ^DIBT(APCLSTMP,1,APCLVDFN)=""""

 .Q

 Q

APCLSTMV  ; IHS/CMI/LAB - CREATE SEARCH TEMPLATE FOR VGEN (VISITS) REPORTS ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;

EN        ;EP - ENTRY POINT

 +1        DO EN1

EXIT       KILL APCLSDIC,APCLSNAM,APCLSTN,DHD

 +1        QUIT 

EN1       ;EP Help Text

 +1        KILL APCLQUIT

 +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",!!

 +4       ;

EN2        KILL DIC,DLAYGO

           SET DLAYGO=.401

           SET DIC="^DIBT("

           SET DIC(0)="AELMQZ"

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

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

 +1        WRITE !

 +2        DO ^DIC

           KILL DLAYGO,DIC

 +3        IF +Y<1

               WRITE !!,"No Search Template selected."

               HANG 2

               SET APCLQUIT=1

               QUIT 

 +4        SET APCLSTMP=+Y

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

 +7                SET APCLSTN=$PIECE(^DIBT(APCLSTMP,0),U)

                   SET DA=APCLSTMP

                   SET DIK="^DIBT("

                   DO ^DIK

 +8                SET ^DIBT(APCLSTMP,0)=APCLSNAM

                   SET DA=APCLSTMP

                   SET DIK="^DIBT("

                   DO IX1^DIK

 +9                LOCK -^DIBT(APCLSTMP)

 +10               QUIT 

               End DoDot:1

               IF Q

                   KILL APCLSTMP,Y

                   GOTO EN2

 +11       IF APCLSTMP

               IF $DATA(^DIBT(APCLSTMP))

                   Begin DoDot:1

 +12                   WRITE !!,?5,"A VISIT list resulting from this report",!,?5,"will be stored in the.........>",!!?18,"**  ",APCLSNAM,"  ** Search Template."

 +13                   KILL ^DIBT(APCLSTMP,1)

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

 +15                   SET DIE="^DIBT("

                       SET DA=APCLSTMP

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

 +16                   DO ^DIE

 +17                   KILL DIE,DA,DR

                   End DoDot:1

 +18      ;Q

 +19      ;Run Template in Background Mode

 +20      ;

 +21      ;

 +22       QUIT 

 +23      ;

SETRECS   ;EP - Set Entries into Template

 +1       ;

 +2        SET APCLSRTV=""

 +3        FOR 

               SET APCLSRTV=$ORDER(^XTMP("APCLVL",APCLJOB,APCLBTH,"DATA HITS",APCLSRTV))

               IF APCLSRTV=""

                   QUIT 

               DO NEXT

 +4        QUIT 

 +5       ;

NEXT      ;2ND $ORDER

 +1        SET APCLVDFN=0

           FOR 

               SET APCLVDFN=$ORDER(^XTMP("APCLVL",APCLJOB,APCLBTH,"DATA HITS",APCLSRTV,APCLVDFN))

               IF APCLVDFN'=+APCLVDFN

                   QUIT 

               Begin DoDot:1

 +2                SET ^DIBT(APCLSTMP,1,APCLVDFN)=""""

 +3                QUIT 

               End DoDot:1

 +4        QUIT