ACHSAVAR.m

ACHSAVAR ; IHS/ITSC/PMF - SET AREA OFFICE CHS OPTIONS ; [ 12/06/2002  10:36 AM ]

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**5**;JUN 11, 2001

 ;IHS/SET/GTH ACHS*3.1*5 12/06/2002 - Remove non-standard error recording.

 I '$D(^ACHSAOP(DUZ(2),0)) D NOTSET("This facility does not have an entry in the 'CHS AREA OFFICE PARAMETERS' file '$D(^ACHSAOP("_DUZ(2)_",0))")

 ;

 I '$D(^ACHSAOP(DUZ(2),2)) D NOTSET("The 'CHS AREA OFFICE PARAMETERS' file node 2 has not been set. Several parameters missing '$D(^ACHSAOP("_DUZ(2)_",2))")

 I $P(^ACHSAOP(DUZ(2),2),U)="" D NOTSET("The 'EOBR IMPORT/SPLITOUT EXPORT' field of the 'CHS AREA OFFICE PARAMETERS' file must contain a directory pathname $P(^ACHSAOP("_DUZ(2)_",2),U)=NULL")

 ;

 I $P(^ACHSAOP(DUZ(2),2),U,7)="" D NOTSET("The 'EOBR ARCHIVE DIRECTORY' field of the 'CHS AREA OFFICE PARAMETERS' file must contain a directory pathname $P(^ACHSAOP("_DUZ(2)_",2),U,7)=NULL")

 ;

 I $P(^ACHSAOP(DUZ(2),2),U,13)="" D NOTSET("The 'FACILITY ARCHIVE DIR' field of the 'CHS AREA OFFICE PARAMETERS' file must contain a directory pathname $P(^ACHSAOP("_DUZ(2)_",2),U,13)=NULL")

 ;

 ;

 N ACHS,ACHSY

 S ACHSY="",ACHS=""

 F  S ACHS=$O(^DD(9002079,"GL",2,ACHS)) Q:+ACHS=0  S ACHSY=ACHSY_$P($G(^ACHSAOP(DUZ(2),2)),U,ACHS)

 Q:ACHSY]""

 ;

 ;

NOTSET(ACHSMSG) ;

 D VIDEO^ACHS

 W !!,*7,"The " W $G(IORVON) W "DENIAL" W $G(IORVOFF) W " parameters forthis site have "

 W $G(IORVON) W "not been properly set." W $G(IORVOFF)

 W !!,$$C^ACHS(ACHSMSG)

 W !!,"Print this screen to a printer."

 W *7,!!,$G(IOBON),$G(IORVON),"Contact your site manager immediately!",$G(IOBOFF),$G(IORVOFF)

 ;S ^ACHSERR($H)=ACHSMSG;SET THE MESSAGE INTO THE ERROR MESSAGE GLOBAL;IHS/SET/GTH ACHS*3.1*5 12/06/2002

 ;D CLEAN^ACHS("");CLEANUP THE ^ACHSERR ERROR MESSAGE GLOBAL;IHS/SET/GTH ACHS*3.1*5 12/06/2002

 W !!,"Press RETURN..."

 D READ^ACHSFU

 S ACHS("NOTSET")="",ACHSXQT=1

 Q

 ;

EDIT ;EP - Edit the Area Office Parameters.

 W !,"For ",$$LOC^ACHS,":"

 N DIE,DA,DR

 S DIE="^ACHSAOP(",DA=DUZ(2),DR="[ACHS AREA PARAMETERS]"

 D ^DIE,RTRN^ACHS

 Q

 ;

ACHSAVAR  ; IHS/ITSC/PMF - SET AREA OFFICE CHS OPTIONS ; [ 12/06/2002  10:36 AM ]

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**5**;JUN 11, 2001

 +2       ;IHS/SET/GTH ACHS*3.1*5 12/06/2002 - Remove non-standard error recording.

 +3        IF '$DATA(^ACHSAOP(DUZ(2),0))

               DO NOTSET("This facility does not have an entry in the 'CHS AREA OFFICE PARAMETERS' file '$D(^ACHSAOP("_DUZ(2)_",0))")

 +4       ;

 +5        IF '$DATA(^ACHSAOP(DUZ(2),2))

               DO NOTSET("The 'CHS AREA OFFICE PARAMETERS' file node 2 has not been set. Several parameters missing '$D(^ACHSAOP("_DUZ(2)_",2))")

 +6        IF $PIECE(^ACHSAOP(DUZ(2),2),U)=""

               DO NOTSET("The 'EOBR IMPORT/SPLITOUT EXPORT' field of the 'CHS AREA OFFICE PARAMETERS' file must contain a directory pathname $P(^ACHSAOP("_DUZ(2)_",2),U)=NULL")

 +7       ;

 +8        IF $PIECE(^ACHSAOP(DUZ(2),2),U,7)=""

               DO NOTSET("The 'EOBR ARCHIVE DIRECTORY' field of the 'CHS AREA OFFICE PARAMETERS' file must contain a directory pathname $P(^ACHSAOP("_DUZ(2)_",2),U,7)=NULL")

 +9       ;

 +10       IF $PIECE(^ACHSAOP(DUZ(2),2),U,13)=""

               DO NOTSET("The 'FACILITY ARCHIVE DIR' field of the 'CHS AREA OFFICE PARAMETERS' file must contain a directory pathname $P(^ACHSAOP("_DUZ(2)_",2),U,13)=NULL")

 +11      ;

 +12      ;

 +13       NEW ACHS,ACHSY

 +14       SET ACHSY=""

           SET ACHS=""

 +15       FOR 

               SET ACHS=$ORDER(^DD(9002079,"GL",2,ACHS))

               IF +ACHS=0

                   QUIT 

               SET ACHSY=ACHSY_$PIECE($GET(^ACHSAOP(DUZ(2),2)),U,ACHS)

 +16       IF ACHSY]""

               QUIT 

 +17      ;

 +18      ;

NOTSET(ACHSMSG) ;

 +1        DO VIDEO^ACHS

 +2        WRITE !!,*7,"The "

           WRITE $GET(IORVON)

           WRITE "DENIAL"

           WRITE $GET(IORVOFF)

           WRITE " parameters forthis site have "

 +3        WRITE $GET(IORVON)

           WRITE "not been properly set."

           WRITE $GET(IORVOFF)

 +4        WRITE !!,$$C^ACHS(ACHSMSG)

 +5        WRITE !!,"Print this screen to a printer."

 +6        WRITE *7,!!,$GET(IOBON),$GET(IORVON),"Contact your site manager immediately!",$GET(IOBOFF),$GET(IORVOFF)

 +7       ;S ^ACHSERR($H)=ACHSMSG;SET THE MESSAGE INTO THE ERROR MESSAGE GLOBAL;IHS/SET/GTH ACHS*3.1*5 12/06/2002

 +8       ;D CLEAN^ACHS("");CLEANUP THE ^ACHSERR ERROR MESSAGE GLOBAL;IHS/SET/GTH ACHS*3.1*5 12/06/2002

 +9        WRITE !!,"Press RETURN..."

 +10       DO READ^ACHSFU

 +11       SET ACHS("NOTSET")=""

           SET ACHSXQT=1

 +12       QUIT 

 +13      ;

EDIT      ;EP - Edit the Area Office Parameters.

 +1        WRITE !,"For ",$$LOC^ACHS,":"

 +2        NEW DIE,DA,DR

 +3        SET DIE="^ACHSAOP("

           SET DA=DUZ(2)

           SET DR="[ACHS AREA PARAMETERS]"

 +4        DO ^DIE

           DO RTRN^ACHS

 +5        QUIT 

 +6       ;