BUD2STMP.m

BUD2STMP ; IHS/CMI/LAB - CREATE SEARCH TEMPLATE FOR PGEN (PATIENT) REPORTS ;

 ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50

 ;

EN ;EP - ENTRY POINT

 D EN1

EXIT K BUDSDIC,BUDSNAM,BUDSTN,DHD

 Q

EN1 ;EP Help

 K BUDQUIT

 W !!,"* You may enter an existing Template Name or Save results in a New Template *"

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,4)=2)&($P(^(0),U,5)=DUZ)"

 W !

 D ^DIC K DIC,DLAYGO

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

 S BUDSTMP=+Y,BUDSNAM=$P(^DIBT(BUDSTMP,0),U)

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

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

 .S ^DIBT(BUDSTMP,0)=BUDSNAM,DA=BUDSTMP,DIK="^DIBT(" D IX1^DIK

 .L -^DIBT(BUDSTMP)

 .Q

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

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

 .K ^DIBT(BUDSTMP,1)

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

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

 .D ^DIE

 .K DIE,DA,DR

 ;Q

 ;Run Template in Background Mode

 ;

 ;

 Q

 ;

SETRECS ;EP - Set Entries into Template

 ;

 S BUDDFN=0 F  S BUDDFN=$O(^XTMP("BUDVL",BUDJOB,BUDBTH,"PATIENTS",BUDDFN)) Q:BUDDFN'=+BUDDFN  D

 .I '$D(^XTMP("BUDVL",BUDJOB,BUDBTH)) W !!,"NO DATA TO REPORT.",! D PAUSE^BUD2UPVL W:$D(IOF) @IOF

 .S ^DIBT(BUDSTMP,1,BUDDFN)=""""

 Q

BUD2STMP  ; IHS/CMI/LAB - CREATE SEARCH TEMPLATE FOR PGEN (PATIENT) REPORTS ;

 +1       ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50

 +2       ;

EN        ;EP - ENTRY POINT

 +1        DO EN1

EXIT       KILL BUDSDIC,BUDSNAM,BUDSTN,DHD

 +1        QUIT 

EN1       ;EP Help

 +1        KILL BUDQUIT

 +2        WRITE !!,"* You may enter an existing Template Name or Save results in a New Template *"

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,4)=2)&($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 BUDQUIT=1

               QUIT 

 +4        SET BUDSTMP=+Y

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

 +7                SET BUDSTN=$PIECE(^DIBT(BUDSTMP,0),U)

                   SET DA=BUDSTMP

                   SET DIK="^DIBT("

                   DO ^DIK

 +8                SET ^DIBT(BUDSTMP,0)=BUDSNAM

                   SET DA=BUDSTMP

                   SET DIK="^DIBT("

                   DO IX1^DIK

 +9                LOCK -^DIBT(BUDSTMP)

 +10               QUIT 

               End DoDot:1

               IF Q

                   KILL BUDSTMP,Y

                   GOTO EN2

 +11       IF BUDSTMP

               IF $DATA(^DIBT(BUDSTMP))

                   Begin DoDot:1

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

 +13                   KILL ^DIBT(BUDSTMP,1)

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

 +15                   SET DIE="^DIBT("

                       SET DA=BUDSTMP

                       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      ;

 +21      ;

 +22       QUIT 

 +23      ;

SETRECS   ;EP - Set Entries into Template

 +1       ;

 +2        SET BUDDFN=0

           FOR 

               SET BUDDFN=$ORDER(^XTMP("BUDVL",BUDJOB,BUDBTH,"PATIENTS",BUDDFN))

               IF BUDDFN'=+BUDDFN

                   QUIT 

               Begin DoDot:1

 +3                IF '$DATA(^XTMP("BUDVL",BUDJOB,BUDBTH))

                       WRITE !!,"NO DATA TO REPORT.",!

                       DO PAUSE^BUD2UPVL

                       IF $DATA(IOF)

                           WRITE @IOF

 +4                SET ^DIBT(BUDSTMP,1,BUDDFN)=""""

               End DoDot:1

 +5        QUIT