BCHEGP.m

BCHEGP ; IHS/CMI/LAB - group preventive services group form ; 

 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27

 ;

START ;

 D INIT

 K BCHQUIT

 D GETDATA

 I $D(BCHQUIT) W !!,"Exiting group form entry" H 2 D EOJ Q

 D ^BCHEGP1

 ;print forms?

PRINT ;

 W !! S DIR(0)="Y",DIR("A")="Do you wish to PRINT a hard copy encounter form for each patient in the group",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q:$D(DIRUT)

 Q:'Y

 S XBRP="PRINT1^BCHEGP",XBRC="",XBRX="EOJ^BCHEGP",XBNS="BCH"

 D ^XBDBQUE

 ;loop through all patients, records and print forms

 W !!!!

 Q

PRINT1 ;

 S BCHR=0 F  S BCHR=$O(^BCHGROUP(BCHFID,21,BCHR)) Q:BCHR'=+BCHR!($G(BCHQUIT))  D PRINT1^BCHUFPP

 Q

INIT ; Write Header

 D ^XBFMK K DIADD,DLAYGO

 D TERM^VALM0

 W:$D(IOF) @IOF

 F BCHEGJ=1:1:11 S BCHEGX=$P($T(TEXT+BCHEGJ),";;",2) W !?80-$L(BCHEGX)\2,BCHEGX

 K BCHEGX,BCHEGJ

 W !!

 S BCHQUIT=""

 D ^BCHUIN

 K ^TMP("BCHEGP",$J)

 D KILL^AUPNPAT

 Q

EOJ ;

 D EN^XBVK("BCH")

 K AUPNPAT,AUPNDAYS,AUPNSEX,AUPNDOB,AUPNDOD

 K %,%W,%Y,X,Y,DIR,DIRUT,DIC,DIE,DA,DR,DTOUT,DUOUT,%DT,DIU,DIV,DIW,DIPGM,DQ,DI,DIG,DIH,X1,X2,ZTSAVE

 D ^XBFMK K DIADD,DLAYGO

 Q

GETDATA ; GET LOCATION OF ENCOUNTER

 W !

 ;create new group form entry

 S X="XXX",DIADD=1,DLAYGO=90002.97,DIC="^BCHGROUP(",DIC(0)="L" K DD,DO D FILE^DICN

 K DIADD,DLAYGO,DIC

 I Y=-1 W !!,"error creating group entry." S BCHQUIT=1

 S BCHFID=+Y

 D ^XBFMK

 S DA=BCHFID,Z="G"_BCHFID,DIE="^BCHGROUP(",DR=".01///"_Z D ^DIE K DIE,DR,DA

 W !!,"The form ID for this group form is ",$P(^BCHGROUP(BCHFID,0),U),".",!,"Please make a note of this.  It will be needed if and when you need to ",!,"re-print forms.",!!

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

EDIT ;

 S DA=BCHFID,DDSFILE=90002.97,DR="[BCH GROUP ENTRY]" D ^DDS

 I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!!  ***NOTIFY PROGRAMMER***" S BCHQUIT=1 K DIMSG Q

 S C=0 I '$O(^BCHRGAS("AD",BCHFID,0)) W !!,"At least one POV is required!" S C=1

 F X=1:1:4,6,11,12 I $P(^BCHGROUP(BCHFID,0),U,X)="" S C=1

 S Y=0 F  S Y=$O(^BCHRGAS("AD",BCHFID,Y)) Q:Y'=+Y  F X=1,4,5,6 I $P(^BCHRGAS(Y,0),U,X)="" S C=1

 I C W !!,"Not all required data elements have been entered." D  G:Y="E" EDIT W !,"Deleting group definition..." D DELGRP Q

 .S DIR(0)="S^E:Edit and Complete the Group Definition;D:Delete the Incomplete Definition",DIR("A")="What do you want to do",DIR("B")="E" KILL DA D ^DIR KILL DIR

 .I $D(DIRUT) S Y="D"

 .Q

 Q:$D(BCHQUIT)

 S BCHNUM=$P(^BCHGROUP(BCHFID,0),U,12)

 ;DISPLAY AND CONFIRM

 W !!,"I am going to ask you to enter ",BCHNUM," patient names.  I will then create a",!,"record in the CHR file for each patient.  The record will contain the",!,"following information: ",!

 S DIC="^BCHGROUP(",DA=BCHFID,DR="0" D EN^DIQ K DIC

 S BCHX=0 F  S BCHX=$O(^BCHRGAS("AD",BCHFID,BCHX)) Q:BCHX'=+BCHX  S DA=BCHX,DIC="^BCHRGAS(",DR=0 D EN^DIQ K DIC

 K DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="Y" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) S BCHQUIT=1 Q

 I 'Y S BCHQUIT=1 Q

 Q

 ;

 ;

FORMID ;

 ;generate form id in file

 K DIC,DO,DD,D0 S X="XXX",DIC(0)="L",DIC="^BCHGROUP(",DIADD=1,DLAYGO=9001002.3,DIC("DR")=".02////"_DUZ_";.03////"_DT_";.04////"_BCHDATE D FILE^DICN I Y=-1 D  Q

 .D ^XBFMK K DIADD,DLAYGO,DLAYGO,DR,DD S BCHQUIT=1 W !!,"Failure to create FORM ID.  Notify programmer.",! Q

 S BCHFID=+Y

 K DIADD,DLAYGO D ^XBFMK

 S DA=BCHFID,Z="G"_BCHFID,DIE="^BCHGROUP(",DR=".01///"_Z D ^DIE K DIE,DR,DA

 W !,"The form ID for this group form is ",$P(^BCHGRP(BCHFID,0),U),".",!,"Please make a note of this.  It will be needed if and when you need to ",!,"re-print forms.",!

 Q

EOP ;EP - End of page.

 Q:$E(IOST)'="C"

 Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))

 NEW DIR

 K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT

 S DIR("A")="Press Enter",DIR(0)="E" D ^DIR

 Q

 ;----------

TEXT ;

 ;;IHS/RPMS CHR REPORTING SYSTEM

 ;;

 ;;*************************

 ;;* GROUP FORM ENTER Mode *

 ;;*************************

 ;;

 ;;You will be asked to enter the data that will be included

 ;;on each patient's visit.  You will then be asked to enter

 ;;each patient's name who attended the group session.  Afer

 ;;that you will be given the opportunity to add measurements

 ;;and/or edit each patient's visit record.

 ;;

 ;

REPRINT ;EP - called from option

 D RXIT

 W:$D(IOF) @IOF

 W !!,"This option should be used to print or re-print group encounter forms.",!!,"You must know the group ID form number or the date of the group visit."

 W !!,"Only group forms entered after PCC Data Entry Patch 5 was installed",!,"are available for re-printing.",!!

 W !!,"Please enter the group ID form or the date of the visit.",!

 D ^XBFMK

 S DIC="^BCHGROUP(",DIC(0)="AEMQ" D ^DIC

 I Y=-1 W !!,"No form selected" H 2 D RXIT Q

 S BCHFID=+Y

 S X=0 F  S X=$O(^BCHGROUP(BCHFID,21,X)) Q:X'=+X  S BCHEGP("FORMS",X)=""

 I '$D(BCHEGP("FORMS")) W !!,"There are no visits to print.",! H 2 D RXIT Q

 W !,"The following visit forms will be printed: "

 S X=0 F  S X=$O(BCHEGP("FORMS",X)) Q:X'=+X  D

 .W !?5,$$VAL^XBDIQ1(90002,X,.01),?30,$$VAL^XBDIQ1(90002,X,.04)

 D PRINT

 D RXIT

 Q

RXIT ;

 D EN^XBVK("BCH")

 D ^XBFMK

 D KILL^AUPNPAT

 Q

DELGRP ;

 NEW BCHX

 S BCHX=0 F  S BCHX=$O(^BCHRGAS("AD",BCHFID,BCHX)) Q:BCHX'=+BCHX  S DIK="^BCHRGAS(",DA=BCHX D ^DIK

 S DA=BCHFID,DIK="^BCHGROUP" D ^DIK K DIK,DA S BCHQUIT=1 K DIR S DIR(0)="E" D ^DIR K DIR

 Q

BCHEGP    ; IHS/CMI/LAB - group preventive services group form ; 

 +1       ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27

 +2       ;

START     ;

 +1        DO INIT

 +2        KILL BCHQUIT

 +3        DO GETDATA

 +4        IF $DATA(BCHQUIT)

               WRITE !!,"Exiting group form entry"

               HANG 2

               DO EOJ

               QUIT 

 +5        DO ^BCHEGP1

 +6       ;print forms?

PRINT     ;

 +1        WRITE !!

           SET DIR(0)="Y"

           SET DIR("A")="Do you wish to PRINT a hard copy encounter form for each patient in the group"

           SET DIR("B")="N"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               QUIT 

 +3        IF 'Y

               QUIT 

 +4        SET XBRP="PRINT1^BCHEGP"

           SET XBRC=""

           SET XBRX="EOJ^BCHEGP"

           SET XBNS="BCH"

 +5        DO ^XBDBQUE

 +6       ;loop through all patients, records and print forms

 +7        WRITE !!!!

 +8        QUIT 

PRINT1    ;

 +1        SET BCHR=0

           FOR 

               SET BCHR=$ORDER(^BCHGROUP(BCHFID,21,BCHR))

               IF BCHR'=+BCHR!($GET(BCHQUIT))

                   QUIT 

               DO PRINT1^BCHUFPP

 +2        QUIT 

INIT      ; Write Header

 +1        DO ^XBFMK

           KILL DIADD,DLAYGO

 +2        DO TERM^VALM0

 +3        IF $DATA(IOF)

               WRITE @IOF

 +4        FOR BCHEGJ=1:1:11

               SET BCHEGX=$PIECE($TEXT(TEXT+BCHEGJ),";;",2)

               WRITE !?80-$LENGTH(BCHEGX)\2,BCHEGX

 +5        KILL BCHEGX,BCHEGJ

 +6        WRITE !!

 +7        SET BCHQUIT=""

 +8        DO ^BCHUIN

 +9        KILL ^TMP("BCHEGP",$JOB)

 +10       DO KILL^AUPNPAT

 +11       QUIT 

EOJ       ;

 +1        DO EN^XBVK("BCH")

 +2        KILL AUPNPAT,AUPNDAYS,AUPNSEX,AUPNDOB,AUPNDOD

 +3        KILL %,%W,%Y,X,Y,DIR,DIRUT,DIC,DIE,DA,DR,DTOUT,DUOUT,%DT,DIU,DIV,DIW,DIPGM,DQ,DI,DIG,DIH,X1,X2,ZTSAVE

 +4        DO ^XBFMK

           KILL DIADD,DLAYGO

 +5        QUIT 

GETDATA   ; GET LOCATION OF ENCOUNTER

 +1        WRITE !

 +2       ;create new group form entry

 +3        SET X="XXX"

           SET DIADD=1

           SET DLAYGO=90002.97

           SET DIC="^BCHGROUP("

           SET DIC(0)="L"

           KILL DD,DO

           DO FILE^DICN

 +4        KILL DIADD,DLAYGO,DIC

 +5        IF Y=-1

               WRITE !!,"error creating group entry."

               SET BCHQUIT=1

 +6        SET BCHFID=+Y

 +7        DO ^XBFMK

 +8        SET DA=BCHFID

           SET Z="G"_BCHFID

           SET DIE="^BCHGROUP("

           SET DR=".01///"_Z

           DO ^DIE

           KILL DIE,DR,DA

 +9        WRITE !!,"The form ID for this group form is ",$PIECE(^BCHGROUP(BCHFID,0),U),".",!,"Please make a note of this.  It will be needed if and when you need to ",!,"re-print forms.",!!

 +10       KILL DIR

           SET DIR(0)="E"

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

           DO ^DIR

           KILL DIR

EDIT      ;

 +1        SET DA=BCHFID

           SET DDSFILE=90002.97

           SET DR="[BCH GROUP ENTRY]"

           DO ^DDS

 +2        IF $DATA(DIMSG)

               WRITE !!,"ERROR IN SCREENMAN FORM!!  ***NOTIFY PROGRAMMER***"

               SET BCHQUIT=1

               KILL DIMSG

               QUIT 

 +3        SET C=0

           IF '$ORDER(^BCHRGAS("AD",BCHFID,0))

               WRITE !!,"At least one POV is required!"

               SET C=1

 +4        FOR X=1:1:4,6,11,12

               IF $PIECE(^BCHGROUP(BCHFID,0),U,X)=""

                   SET C=1

 +5        SET Y=0

           FOR 

               SET Y=$ORDER(^BCHRGAS("AD",BCHFID,Y))

               IF Y'=+Y

                   QUIT 

               FOR X=1,4,5,6

                   IF $PIECE(^BCHRGAS(Y,0),U,X)=""

                       SET C=1

 +6        IF C

               WRITE !!,"Not all required data elements have been entered."

               Begin DoDot:1

 +7                SET DIR(0)="S^E:Edit and Complete the Group Definition;D:Delete the Incomplete Definition"

                   SET DIR("A")="What do you want to do"

                   SET DIR("B")="E"

                   KILL DA

                   DO ^DIR

                   KILL DIR

 +8                IF $DATA(DIRUT)

                       SET Y="D"

 +9                QUIT 

               End DoDot:1

               IF Y="E"

                   GOTO EDIT

               WRITE !,"Deleting group definition..."

               DO DELGRP

               QUIT 

 +10       IF $DATA(BCHQUIT)

               QUIT 

 +11       SET BCHNUM=$PIECE(^BCHGROUP(BCHFID,0),U,12)

 +12      ;DISPLAY AND CONFIRM

 +13       WRITE !!,"I am going to ask you to enter ",BCHNUM," patient names.  I will then create a",!,"record in the CHR file for each patient.  The record will contain the",!,"following information: ",!

 +14       SET DIC="^BCHGROUP("

           SET DA=BCHFID

           SET DR="0"

           DO EN^DIQ

           KILL DIC

 +15       SET BCHX=0

           FOR 

               SET BCHX=$ORDER(^BCHRGAS("AD",BCHFID,BCHX))

               IF BCHX'=+BCHX

                   QUIT 

               SET DA=BCHX

               SET DIC="^BCHRGAS("

               SET DR=0

               DO EN^DIQ

               KILL DIC

 +16       KILL DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y

           SET DIR(0)="Y"

           SET DIR("A")="Do you wish to continue"

           SET DIR("B")="Y"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +17       IF $DATA(DIRUT)

               SET BCHQUIT=1

               QUIT 

 +18       IF 'Y

               SET BCHQUIT=1

               QUIT 

 +19       QUIT 

 +20      ;

 +21      ;

FORMID    ;

 +1       ;generate form id in file

 +2        KILL DIC,DO,DD,D0

           SET X="XXX"

           SET DIC(0)="L"

           SET DIC="^BCHGROUP("

           SET DIADD=1

           SET DLAYGO=9001002.3

           SET DIC("DR")=".02////"_DUZ_";.03////"_DT_";.04////"_BCHDATE

           DO FILE^DICN

           IF Y=-1

               Begin DoDot:1

 +3                DO ^XBFMK

                   KILL DIADD,DLAYGO,DLAYGO,DR,DD

                   SET BCHQUIT=1

                   WRITE !!,"Failure to create FORM ID.  Notify programmer.",!

                   QUIT 

               End DoDot:1

               QUIT 

 +4        SET BCHFID=+Y

 +5        KILL DIADD,DLAYGO

           DO ^XBFMK

 +6        SET DA=BCHFID

           SET Z="G"_BCHFID

           SET DIE="^BCHGROUP("

           SET DR=".01///"_Z

           DO ^DIE

           KILL DIE,DR,DA

 +7        WRITE !,"The form ID for this group form is ",$PIECE(^BCHGRP(BCHFID,0),U),".",!,"Please make a note of this.  It will be needed if and when you need to ",!,"re-print forms.",!

 +8        QUIT 

EOP       ;EP - End of page.

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

               QUIT 

 +2        IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))

               QUIT 

 +3        NEW DIR

 +4        KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT

 +5        SET DIR("A")="Press Enter"

           SET DIR(0)="E"

           DO ^DIR

 +6        QUIT 

 +7       ;----------

TEXT      ;

 +1       ;;IHS/RPMS CHR REPORTING SYSTEM

 +2       ;;

 +3       ;;*************************

 +4       ;;* GROUP FORM ENTER Mode *

 +5       ;;*************************

 +6       ;;

 +7       ;;You will be asked to enter the data that will be included

 +8       ;;on each patient's visit.  You will then be asked to enter

 +9       ;;each patient's name who attended the group session.  Afer

 +10      ;;that you will be given the opportunity to add measurements

 +11      ;;and/or edit each patient's visit record.

 +12      ;;

 +13      ;

REPRINT   ;EP - called from option

 +1        DO RXIT

 +2        IF $DATA(IOF)

               WRITE @IOF

 +3        WRITE !!,"This option should be used to print or re-print group encounter forms.",!!,"You must know the group ID form number or the date of the group visit."

 +4        WRITE !!,"Only group forms entered after PCC Data Entry Patch 5 was installed",!,"are available for re-printing.",!!

 +5        WRITE !!,"Please enter the group ID form or the date of the visit.",!

 +6        DO ^XBFMK

 +7        SET DIC="^BCHGROUP("

           SET DIC(0)="AEMQ"

           DO ^DIC

 +8        IF Y=-1

               WRITE !!,"No form selected"

               HANG 2

               DO RXIT

               QUIT 

 +9        SET BCHFID=+Y

 +10       SET X=0

           FOR 

               SET X=$ORDER(^BCHGROUP(BCHFID,21,X))

               IF X'=+X

                   QUIT 

               SET BCHEGP("FORMS",X)=""

 +11       IF '$DATA(BCHEGP("FORMS"))

               WRITE !!,"There are no visits to print.",!

               HANG 2

               DO RXIT

               QUIT 

 +12       WRITE !,"The following visit forms will be printed: "

 +13       SET X=0

           FOR 

               SET X=$ORDER(BCHEGP("FORMS",X))

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +14               WRITE !?5,$$VAL^XBDIQ1(90002,X,.01),?30,$$VAL^XBDIQ1(90002,X,.04)

               End DoDot:1

 +15       DO PRINT

 +16       DO RXIT

 +17       QUIT 

RXIT      ;

 +1        DO EN^XBVK("BCH")

 +2        DO ^XBFMK

 +3        DO KILL^AUPNPAT

 +4        QUIT 

DELGRP    ;

 +1        NEW BCHX

 +2        SET BCHX=0

           FOR 

               SET BCHX=$ORDER(^BCHRGAS("AD",BCHFID,BCHX))

               IF BCHX'=+BCHX

                   QUIT 

               SET DIK="^BCHRGAS("

               SET DA=BCHX

               DO ^DIK

 +3        SET DA=BCHFID

           SET DIK="^BCHGROUP"

           DO ^DIK

           KILL DIK,DA

           SET BCHQUIT=1

           KILL DIR

           SET DIR(0)="E"

           DO ^DIR

           KILL DIR

 +4        QUIT