Routine: BCHEGR2

BCHEGR2 ; IHS/CMI/LAB - GROUP DEFINTION ENTRY OF PATIENTS ;

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

GETPAT ;EP

W !

 ;W:$D(IOF) @IOF

 S (BCHPT,BCHPTT)=""

 W !!?15,"******   P A T I E N T   I N F O R M A T I O N   ******",!!

 W !,"If this encounter involved a particular patient, please enter the patient's",!,"chart # or name now.  If this is not a single patient encounter,",!,"but a group encounter, simply HIT the RETURN key to continue.",!

 W !,"Please enter the patient information now.",!

 S DFN=""

 S DIR(0)="FO^1:30",DIR("A")="Enter PATIENT NAME or CHART #"

 S DIR("?",1)="     To find a patient, you can enter the patient's chart number;"

 S DIR("?",2)="     lastname,firstname; SSN; or DOB."

 S DIR("?",3)=" "

 S DIR("?",4)="     If the patient cannot be found in the Patient Registration"

 S DIR("?",5)="     database and you would like to capture demographic information"

 S DIR("?",6)="     for this patient into the CHR database, answer NO when asked"

 S DIR("?",7)="     if you would like to try another lookup.  You will then be"

 S DIR("?",8)="     given the opportunity to capture the patient's demographic"

 S DIR("?",9)="     data on the following screen."

 S DIR("?",10)=""

 S DIR("?",11)="     Registered patient demographic data can only be edit via the"

 S DIR("?")="     Patient Registration system."

 ;W !,"So far you have entered ",BCHHIT," patient records out of a total of ",BCHNUM,".",!

 ;I BCHHIT W "You have entered records for: " D  W !!

 ;.S X=0 F  S X=$O(^BCHGROUP(BCHFID,21,X)) Q:X'=+X  W !?5,$P($G(^BCHR(X,11)),U)

 D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I Y="" W !!,"No patient entered!! - Required",! G GETPAT

 I $D(DIRUT) W !,"No patient entered!! - Required." S BCHQUIT=1 Q

 S (X,BCHNAME)=Y,DIC="^AUPNPAT(",DIC(0)="MQE" D ^DIC K DIC

 I Y=-1 D NOREG Q

 W !?25,"Ok" S %=1 D YN^DICN I %'=1 W !!,"Try again.",! G GETPAT

 S BCHPT=+Y

 S BCHPTT="R"

NOREG ;

 K BCHAGAIN

 W !,"That patient cannot be found in the Registration database."

 W ! S DIR(0)="Y",DIR("A")="Do you want to try to lookup the patient in registration again",DIR("B")="Y" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) W !,"Exiting..." S BCHQUIT=1 Q

 I Y G GETPAT

 W !!,"Please select a patient from the Non-Registered Patient Database",!,"or enter a new Non-Registered Patient.",!

 S DIC="^BCHRPAT(",DIC(0)="AEMQL" D ^DIC K DIC

 I Y=-1 W !!,"A patient is Required" G GETPAT

 S BCHNRPAT=+Y,BCHPT=+Y,BCHPTT="N"

 I $P(Y,U,3) D  I 1

 .W !!,"Please review and update if necessary this non-registered patient's data:"

 .S DIE="^BCHRPAT(",DR="[BCH EDIT NON REG PT]",DA=BCHNRPAT D ^DIE K DA,DIE,DR

 E  D

 .W !!,"You now have the opportunity to update this patient's demographic data,"

 .W !,"(DOB, Gender, Community of Residene, Tribe)",!

 .S DIR(0)="Y",DIR("A")="Do you want to update this patient's demographic information?",DIR("B")="N" KILL DA D ^DIR KILL DIR

 .I 'Y Q

 .I $D(DIRUT) Q

 .S DIE="^BCHRPAT(",DR="[BCH EDIT NON REG PT]",DA=BCHNRPAT D ^DIE K DA,DIE,DR

BCHEGR2   ; IHS/CMI/LAB - GROUP DEFINTION ENTRY OF PATIENTS ;

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

 +2       ;

GETPAT    ;EP

 +1        WRITE !

 +2       ;W:$D(IOF) @IOF

 +3        SET (BCHPT,BCHPTT)=""

 +4        WRITE !!?15,"******   P A T I E N T   I N F O R M A T I O N   ******",!!

 +5        WRITE !,"If this encounter involved a particular patient, please enter the patient's",!,"chart # or name now.  If this is not a single patient encounter,",!,"but a group encounter, simply HIT the RETURN key to continue.",!

 +6        WRITE !,"Please enter the patient information now.",!

 +7        SET DFN=""

 +8        SET DIR(0)="FO^1:30"

           SET DIR("A")="Enter PATIENT NAME or CHART #"

 +9        SET DIR("?",1)="     To find a patient, you can enter the patient's chart number;"

 +10       SET DIR("?",2)="     lastname,firstname; SSN; or DOB."

 +11       SET DIR("?",3)=" "

 +12       SET DIR("?",4)="     If the patient cannot be found in the Patient Registration"

 +13       SET DIR("?",5)="     database and you would like to capture demographic information"

 +14       SET DIR("?",6)="     for this patient into the CHR database, answer NO when asked"

 +15       SET DIR("?",7)="     if you would like to try another lookup.  You will then be"

 +16       SET DIR("?",8)="     given the opportunity to capture the patient's demographic"

 +17       SET DIR("?",9)="     data on the following screen."

 +18       SET DIR("?",10)=""

 +19       SET DIR("?",11)="     Registered patient demographic data can only be edit via the"

 +20       SET DIR("?")="     Patient Registration system."

 +21      ;W !,"So far you have entered ",BCHHIT," patient records out of a total of ",BCHNUM,".",!

 +22      ;I BCHHIT W "You have entered records for: " D  W !!

 +23      ;.S X=0 F  S X=$O(^BCHGROUP(BCHFID,21,X)) Q:X'=+X  W !?5,$P($G(^BCHR(X,11)),U)

 +24       DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +25       IF Y=""

               WRITE !!,"No patient entered!! - Required",!

               GOTO GETPAT

 +26       IF $DATA(DIRUT)

               WRITE !,"No patient entered!! - Required."

               SET BCHQUIT=1

               QUIT

 +27       SET (X,BCHNAME)=Y

           SET DIC="^AUPNPAT("

           SET DIC(0)="MQE"

           DO ^DIC

           KILL DIC

 +28       IF Y=-1

               DO NOREG

               QUIT

 +29       WRITE !?25,"Ok"

           SET %=1

           DO YN^DICN

           IF %'=1

               WRITE !!,"Try again.",!

               GOTO GETPAT

 +30       SET BCHPT=+Y

 +31       SET BCHPTT="R"

 +32       QUIT

 +33      ;

NOREG     ;

 +1        KILL BCHAGAIN

 +2        WRITE !,"That patient cannot be found in the Registration database."

 +3        WRITE !

           SET DIR(0)="Y"

           SET DIR("A")="Do you want to try to lookup the patient in registration again"

           SET DIR("B")="Y"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +4        IF $DATA(DIRUT)

               WRITE !,"Exiting..."

               SET BCHQUIT=1

               QUIT

 +5        IF Y

               GOTO GETPAT

 +6        WRITE !!,"Please select a patient from the Non-Registered Patient Database",!,"or enter a new Non-Registered Patient.",!

 +7        SET DIC="^BCHRPAT("

           SET DIC(0)="AEMQL"

           DO ^DIC

           KILL DIC

 +8        IF Y=-1

               WRITE !!,"A patient is Required"

               GOTO GETPAT

 +9        SET BCHNRPAT=+Y

           SET BCHPT=+Y

           SET BCHPTT="N"

 +10       IF $PIECE(Y,U,3)

               Begin DoDot:1

 +11               WRITE !!,"Please review and update if necessary this non-registered patient's data:"

 +12               SET DIE="^BCHRPAT("

                   SET DR="[BCH EDIT NON REG PT]"

                   SET DA=BCHNRPAT

                   DO ^DIE

                   KILL DA,DIE,DR

               End DoDot:1

               IF 1

 +13      IF '$TEST

               Begin DoDot:1

 +14               WRITE !!,"You now have the opportunity to update this patient's demographic data,"

 +15               WRITE !,"(DOB, Gender, Community of Residene, Tribe)",!

 +16               SET DIR(0)="Y"

                   SET DIR("A")="Do you want to update this patient's demographic information?"

                   SET DIR("B")="N"

                   KILL DA

                   DO ^DIR

                   KILL DIR

 +17               IF 'Y

                       QUIT

 +18               IF $DATA(DIRUT)

                       QUIT

 +19               SET DIE="^BCHRPAT("

                   SET DR="[BCH EDIT NON REG PT]"

                   SET DA=BCHNRPAT

                   DO ^DIE

                   KILL DA,DIE,DR

               End DoDot:1

 +20       QUIT

BCHEGR2.m