Routine: APCLOCCK

APCLOCCK ; IHS/CMI/LAB - Extrinsic Functions to check visit location ;

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

 ;----->  The user is given a chance to select locations.  If they

 ;        select one of the three methods to select a location, but

 ;        fail in their attempt, they are returned to the MAIN prompt

 ;        based on the APCLFLAG variable, and given a second chance.

 ;----->  Only failure to respond to the MAIN prompt will result in

 ;        a returned value of -1.

GETLOC(APCLOCCK) ;EP - Entry point of extrinsic function

 ;----->  Return a -1 if the user does not select a facility

 ;----->  Return a 0 if the user wants all facilities

 ;----->  Return a string if the user selects one or more facilities

 ;        LocationIEN1_U_LocationIEN2_U_LocationIEN3 etc.

MAIN ;

 S APCLOCCK=""

 W !!,"You may include visits from all facilities, from one of more facilities"

 W !,"selected individually, from all facilities within a Service Unit, or from"

 W !,"a pre-defined Taxonomy (Search Template) of facilities"

 K DIR

 S DIR(0)="SM^1:All;2:Individually;3:For a Service Unit;4:From a Taxonomy"

 S DIR("A")="Do you want to select"

 S DIR("?")="If you select from a taxonomy, you must have already created one.  If you select individually, you will be prompted for one or more entries."

 D ^DIR

 I $D(DIRUT) S APCLOCCK=-1 G EXIT

 S APCLFLAG=0

 I Y=1 D ALL

 I Y=2 D INDIV

 I Y=3 D SERVUNIT

 I Y=4 D TAXONOMY

 I APCLFLAG=0 G MAIN

EXIT ;

 K DIC,DIR,DIE,DR

 K APCLFLAG

 Q APCLOCCK

ALL ;----->  Get all facilities

 S APCLFLAG=1

 S APCLLOC=""

INDIV ;----->  Get one of more facilities individually

 S APCLOCCK=""

W !

 K DIC,DIE,DR

 S DIC="^AUTTLOC(",DIC(0)="AEQMZ"

 F  D  Q:X=""  Q:X["^"

 .D ^DIC

 .I X="" Q

 .I X["^" Q

 .I Y'>0 Q

 .W !

 .S:APCLOCCK]"" APCLOCCK=APCLOCCK_U

 .S APCLOCCK=APCLOCCK_+Y

 .;I $L(APCLOCCK)>230 W !,"Maximum entries reached" S X="" Q

 .S APCLFLAG=2

 K DIC,DIE,DR

SERVUNIT ;----->  Get all facilities within a service unit

 S APCLOCCK=""

W !

 K DIC,DIE,DR

 S DIC="^AUTTSU(",DIC(0)="AEQMZ"

 D ^DIC

 K DIC,DIE,DR

 I Y'>0 Q

 S X=$P(^AUTTSU(+Y,0),U,4)  ;ASU Index

 S N=X_"00"  ;Set beginning of ASUFAC Index range

 S X=X_"99"  ;Set end of ASUFAC Index range

 F  S N=$O(^AUTTLOC("C",N)) Q:N>X  Q:N=""  D  Q:X=""

 .S:APCLOCCK]"" APCLOCCK=APCLOCCK_U

 .S APCLOCCK=APCLOCCK_$O(^AUTTLOC("C",N,0))

 .;I $L(APCLOCCK)>230 W !,"Maximum entries reached" S N="" Q

 .S APCLFLAG=3

TAXONOMY ;----->  Get all facilties within a taxonomy

 S APCLOCCK=""

W !

 K DR,DIC,DIE

 S DIC("S")="I $P(^(0),U,15)=9999999.06"

 S DIC="^ATXAX(",DIC(0)="AEQMZ"

 S DIC("A")="Which Taxonomy do you want? "

 D ^DIC

 K DIC,DIE,DR

 I Y'>0 Q

 ;----->  Loop through entries in the taxonomy to populate APCLOCCK

 S N=0

 F  S N=$O(^ATXAX(+Y,21,N)) Q:'N  D

 .;I $L(APCLOCCK)>230 W !,"Maximum entries reached" S N=999999 Q

 .S Z=$P(^ATXAX(+Y,21,N,0),U)

 .I APCLOCCK]"" S APCLOCCK=APCLOCCK_U

 .S APCLOCCK=APCLOCCK_Z

 W !!,"Taxonomy Entries added!",!

 S APCLFLAG=4

 ;----->  Check if template is from Location or Institution file

 I $P(^DIBT(+Y,0),U,4)?.A1"4" S APCLFLAG=4

 I $P(^DIBT(+Y,0),U,4)?.A1"9999999.06" S APCLFLAG=4

 ;----->  If template does not point to correct file, check to see

 ;----->  if the .01 field from the file associated with that template

 ;----->  points to the correct file.

 I APCLFLAG=0 D

 .W !!,"The template you selected was not created from the Location file!!"

 .W !!,"I am now checking to see if the file associated with this template"

 .W !,"points to the Location file."

 .S X=$P(^DIBT(+Y,0),U,4)

 .I '+X F  S X=$E(X,2,99) Q:+X  Q:X=""

 .I X="" Q

 .S X=$P(^DD(+X,.01,0),U,2)

 .I '+X F  S X=$E(X,2,99) Q:X=""  Q:+X

 .I +X?1"9999999.06" W "  YES IT DOES!" S APCLFLAG=4

 .I +X?1"4" W "  YES IT DOES!" S APCLFLAG=4

 ;----->  Taxonomy doesn't point to the Location or Institution file

 I APCLFLAG=0 D  Q

 .W "   NOPE!"

 .W !!,"SORRY!  I'm not smart enough to do anything with THIS template!!"

CHKLOC(APCLOCCK,APCLDUZ2)   ;EP ----->  Entry point for extrinsic function

 ;----->  Return a 1 if the facility is in the list

 ;----->  Return a 0 if the facility is not in the list

 ;----->  Return a 1 if the list equals 0 (all facilities)

 I $G(APCLOCCK)="" Q 1

 I $G(APCLDUZ2)="" Q 0

 I APCLOCCK=0 Q 1

 S APCLOCCK=U_APCLOCCK_U

 S APCLDUZ2=U_APCLDUZ2_U

 I APCLOCCK[APCLDUZ2 Q 1

Q 0

APCLOCCK  ; IHS/CMI/LAB - Extrinsic Functions to check visit location ;

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

 +2       ;

 +3       ;----->  The user is given a chance to select locations.  If they

 +4       ;        select one of the three methods to select a location, but

 +5       ;        fail in their attempt, they are returned to the MAIN prompt

 +6       ;        based on the APCLFLAG variable, and given a second chance.

 +7       ;

 +8       ;----->  Only failure to respond to the MAIN prompt will result in

 +9       ;        a returned value of -1.

 +10      ;

GETLOC(APCLOCCK) ;EP - Entry point of extrinsic function

 +1       ;

 +2       ;----->  Return a -1 if the user does not select a facility

 +3       ;----->  Return a 0 if the user wants all facilities

 +4       ;----->  Return a string if the user selects one or more facilities

 +5       ;

 +6       ;        LocationIEN1_U_LocationIEN2_U_LocationIEN3 etc.

 +7       ;

MAIN      ;

 +1        SET APCLOCCK=""

 +2        WRITE !!,"You may include visits from all facilities, from one of more facilities"

 +3        WRITE !,"selected individually, from all facilities within a Service Unit, or from"

 +4        WRITE !,"a pre-defined Taxonomy (Search Template) of facilities"

 +5        KILL DIR

 +6        SET DIR(0)="SM^1:All;2:Individually;3:For a Service Unit;4:From a Taxonomy"

 +7        SET DIR("A")="Do you want to select"

 +8        SET DIR("?")="If you select from a taxonomy, you must have already created one.  If you select individually, you will be prompted for one or more entries."

 +9        DO ^DIR

 +10       IF $DATA(DIRUT)

               SET APCLOCCK=-1

               GOTO EXIT

 +11       SET APCLFLAG=0

 +12       IF Y=1

               DO ALL

 +13       IF Y=2

               DO INDIV

 +14       IF Y=3

               DO SERVUNIT

 +15       IF Y=4

               DO TAXONOMY

 +16       IF APCLFLAG=0

               GOTO MAIN

 +17      ;

EXIT      ;

 +1        KILL DIC,DIR,DIE,DR

 +2        KILL APCLFLAG

 +3        QUIT APCLOCCK

 +4       ;

ALL       ;----->  Get all facilities

 +1        SET APCLFLAG=1

 +2        SET APCLLOC=""

 +3        QUIT

 +4       ;

INDIV     ;----->  Get one of more facilities individually

 +1        SET APCLOCCK=""

 +2        WRITE !

 +3        KILL DIC,DIE,DR

 +4        SET DIC="^AUTTLOC("

           SET DIC(0)="AEQMZ"

 +5        FOR

               Begin DoDot:1

 +6                DO ^DIC

 +7                IF X=""

                       QUIT

 +8                IF X["^"

                       QUIT

 +9                IF Y'>0

                       QUIT

 +10               WRITE !

 +11               IF APCLOCCK]""

                       SET APCLOCCK=APCLOCCK_U

 +12               SET APCLOCCK=APCLOCCK_+Y

 +13      ;I $L(APCLOCCK)>230 W !,"Maximum entries reached" S X="" Q

 +14               SET APCLFLAG=2

               End DoDot:1

               IF X=""

                   QUIT

               IF X["^"

                   QUIT

 +15       KILL DIC,DIE,DR

 +16       QUIT

 +17      ;

SERVUNIT  ;----->  Get all facilities within a service unit

 +1        SET APCLOCCK=""

 +2        WRITE !

 +3        KILL DIC,DIE,DR

 +4        SET DIC="^AUTTSU("

           SET DIC(0)="AEQMZ"

 +5        DO ^DIC

 +6        KILL DIC,DIE,DR

 +7        IF Y'>0

               QUIT

 +8       ;

 +9       ;ASU Index

           SET X=$PIECE(^AUTTSU(+Y,0),U,4)

 +10      ;Set beginning of ASUFAC Index range

           SET N=X_"00"

 +11      ;Set end of ASUFAC Index range

           SET X=X_"99"

 +12       FOR

               SET N=$ORDER(^AUTTLOC("C",N))

               IF N>X

                   QUIT

               IF N=""

                   QUIT

               Begin DoDot:1

 +13               IF APCLOCCK]""

                       SET APCLOCCK=APCLOCCK_U

 +14               SET APCLOCCK=APCLOCCK_$ORDER(^AUTTLOC("C",N,0))

 +15      ;I $L(APCLOCCK)>230 W !,"Maximum entries reached" S N="" Q

 +16               SET APCLFLAG=3

               End DoDot:1

               IF X=""

                   QUIT

 +17       QUIT

 +18      ;

TAXONOMY  ;----->  Get all facilties within a taxonomy

 +1        SET APCLOCCK=""

 +2        WRITE !

 +3        KILL DR,DIC,DIE

 +4        SET DIC("S")="I $P(^(0),U,15)=9999999.06"

 +5        SET DIC="^ATXAX("

           SET DIC(0)="AEQMZ"

 +6        SET DIC("A")="Which Taxonomy do you want? "

 +7        DO ^DIC

 +8        KILL DIC,DIE,DR

 +9        IF Y'>0

               QUIT

 +10      ;

 +11      ;----->  Loop through entries in the taxonomy to populate APCLOCCK

 +12       SET N=0

 +13       FOR

               SET N=$ORDER(^ATXAX(+Y,21,N))

               IF 'N

                   QUIT

               Begin DoDot:1

 +14      ;I $L(APCLOCCK)>230 W !,"Maximum entries reached" S N=999999 Q

 +15               SET Z=$PIECE(^ATXAX(+Y,21,N,0),U)

 +16               IF APCLOCCK]""

                       SET APCLOCCK=APCLOCCK_U

 +17               SET APCLOCCK=APCLOCCK_Z

               End DoDot:1

 +18       WRITE !!,"Taxonomy Entries added!",!

 +19       SET APCLFLAG=4

 +20       QUIT

 +21      ;----->  Check if template is from Location or Institution file

 +22       IF $PIECE(^DIBT(+Y,0),U,4)?.A1"4"

               SET APCLFLAG=4

 +23       IF $PIECE(^DIBT(+Y,0),U,4)?.A1"9999999.06"

               SET APCLFLAG=4

 +24      ;

 +25      ;----->  If template does not point to correct file, check to see

 +26      ;----->  if the .01 field from the file associated with that template

 +27      ;----->  points to the correct file.

 +28       IF APCLFLAG=0

               Begin DoDot:1

 +29               WRITE !!,"The template you selected was not created from the Location file!!"

 +30               WRITE !!,"I am now checking to see if the file associated with this template"

 +31               WRITE !,"points to the Location file."

 +32               SET X=$PIECE(^DIBT(+Y,0),U,4)

 +33               IF '+X

FOR

                           SET X=$EXTRACT(X,2,99)

                           IF +X

                               QUIT

                           IF X=""

                               QUIT

 +34               IF X=""

                       QUIT

 +35               SET X=$PIECE(^DD(+X,.01,0),U,2)

 +36               IF '+X

FOR

                           SET X=$EXTRACT(X,2,99)

                           IF X=""

                               QUIT

                           IF +X

                               QUIT

 +37               IF +X?1"9999999.06"

                       WRITE "  YES IT DOES!"

                       SET APCLFLAG=4

 +38               IF +X?1"4"

                       WRITE "  YES IT DOES!"

                       SET APCLFLAG=4

               End DoDot:1

 +39      ;

 +40      ;----->  Taxonomy doesn't point to the Location or Institution file

 +41       IF APCLFLAG=0

               Begin DoDot:1

 +42               WRITE "   NOPE!"

 +43               WRITE !!,"SORRY!  I'm not smart enough to do anything with THIS template!!"

               End DoDot:1

               QUIT

 +44      ;

 +45       QUIT

 +46      ;

 +47      ;

CHKLOC(APCLOCCK,APCLDUZ2) ;EP ----->  Entry point for extrinsic function

 +1       ;

 +2       ;----->  Return a 1 if the facility is in the list

 +3       ;----->  Return a 0 if the facility is not in the list

 +4       ;----->  Return a 1 if the list equals 0 (all facilities)

 +5       ;

 +6        IF $GET(APCLOCCK)=""

               QUIT 1

 +7        IF $GET(APCLDUZ2)=""

               QUIT 0

 +8        IF APCLOCCK=0

               QUIT 1

 +9        SET APCLOCCK=U_APCLOCCK_U

 +10       SET APCLDUZ2=U_APCLDUZ2_U

 +11       IF APCLOCCK[APCLDUZ2

               QUIT 1

 +12       QUIT 0

APCLOCCK.m