ACHSSTL.m

ACHSSTL ; IHS/ITSC/PMF - CHS FACILITY PARAMETER SET UP;    [ 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 - Fix index to prevent overwrite of print Q for other facilities.

 D VIDEO^ACHS

 S ACHSDUZ2=""

 W @IOF,$G(IORVON),!,$$REPEAT^XLFSTR("*",78)

 W !,"*",?77,"*",!

 W "*",?30,"CONTRACT HEALTH SYSTEM",?77,"*",!

 W "*",?31,"FACILITY PARAMETER SET UP",?77,"*",!

 W "*",?77,"*",!,$$REPEAT^XLFSTR("*",78),$G(IORVOFF),!!

 S Y=$$DIR^XBDIR("PO^4:AEMQ","What Facility's Parameters Will You Be Entering")

 G:(Y<1)!$D(DTOUT)!$D(DUOUT) END

 S ACHSDUZ2=+Y

 ;

 S Y=$$DIR^XBDIR("YO","Is This Facility a 638 Facility","","","","",2)

 G:Y=""!$D(DTOUT)!$D(DUOUT) END

 I Y=1 S ACHS638=""

 I Y=0 K ACHS638

 ;

 D LIST I STOP D END Q

 ;

 D STDPAR

 D ^ACHSSTL1,^ACHSSTL2

 D SIG,DATA,FI

 D INDEX,END

 ;

 ;

 W !!!!!,"Install Complete!!",!!

 Q

LIST ;

 W @IOF

 W !,$$REPEAT^XLFSTR("*",78)

 W !!,"You should know the following items before installing CHS",!

 W !,"Check With The CHS Department For The Information If You Don't Have It ",!

 W !,"1.  CHS Mailing Address (Street,City,State,Zip)"

 W !,"2.  The Start Date Of Your Fiscal Year If Not Oct 1 (638 Facilities Only)"

 W !,"3.  CHS Common Accounting Numbers And The Cost Center(s) For Each"

 W !,"4.  Values For Allowable Overpayment For Each Document Type"

 W !,"5.  Normal Amount That Each Document Can Be Issued For"

 W !,"6.  Absolute Maximum That Document Can Be Issued For"

 W !,"7.  Name(s) and Title(s) Of Person(s) Who Will Sign Documents"

 W !,"8.  Name and Address Of Fiscal Intermediary",!,"    (If Other Than Blue Cross/Blue Shield of New Mexico)"

 W !,"9.  Current Advice Of Allowance"

 W !,"10. List of High Volume Providers That Will Be Participating In That Program",!

 W $$REPEAT^XLFSTR("*",78),!

 S STOP='$$DIR^XBDIR("E")

 Q

 ;

STDPAR ;

 I $D(^ACHSF(ACHSDUZ2,2)) Q

 W !,$$C^XBFUNC("Installing standard parameters...")

 ;

 S ^ACHSF(ACHSDUZ2,2)="^N^N^Y^Y^N^Y^Y^Y^N^Y^Y^N^N^N^N^N^N^P^N^1^N^N^N^N^N"

 S ^ACHSF(ACHSDUZ2,0)=ACHSDUZ2_"^^^^^1001^1^N^N^^^"

 I $D(ACHS638) D

 . S $P(^ACHSF(ACHSDUZ2,0),U,8)="Y"

 . S Y=$$DIR^XBDIR("Y","Do You Wish To Edit The Fiscal Year Start Date (DEFAULT=OCT 1)","","","","",1)

 . Q:'Y

 . S DIE="^ACHSF(",DA=ACHSDUZ2,DR="11.01;11.02"

 . D ^DIE

 . Q

 ;

 S ACHSFY=$E(DT,1,3)

 I $P(^ACHSF(ACHSDUZ2,0),U,6)<$E(DT,4,7) S ACHSFY=ACHSFY+1

 S ACHSFY=ACHSFY+1700

 Q

 ;

SIG ;

 I $D(^ACHSF(ACHSDUZ2,"P")) Q

 W !!,"Enter Name and Title Of Person Signing Documents...",!!

 S DIE="^ACHSF(",DA=+ACHSDUZ2,DR="50;51;52"

 D ^DIE

 Q

 ;

DATA ;

 I $D(^ACHS(9,ACHSDUZ2)) Q

 W !,$$C^XBFUNC("Installing 'CHS DATA CONTROL FILE'...")

 S:'$D(^ACHS(9,0)) ^(0)="CHS DATA CONTROL^9002069P"

 S:'$D(^ACHS(9,ACHSDUZ2,0)) ^(0)=ACHSDUZ2_"^^1^1"

 S:'$D(^ACHS(9,ACHSDUZ2,"FY",0)) ^(0)="^9002069.01^"_ACHSFY_"^1"

 S:'$D(^ACHS(9,ACHSDUZ2,"FY",ACHSFY,0)) ^(0)=ACHSFY_"^0^0"

 S:'$D(^ACHS(9,ACHSDUZ2,"FY",ACHSFY,1)) ^(1)="0^0^0^0^0^0^0"

 S:'$D(^ACHS(9,ACHSDUZ2,"FY",ACHSFY,"C")) ^("C")=0

 S:'$D(^ACHS(9,ACHSDUZ2,"FY",ACHSFY,"W",0)) ^(0)="^9002069.02A^1^1"

 S:'$D(^ACHS(9,ACHSDUZ2,"FY",ACHSFY,"W",1,0)) ^ACHS(9,ACHSDUZ2,"FY",ACHSFY,"W",1,0)=1

 S:'$D(^ACHS(9,ACHSDUZ2,"FY",ACHSFY,"W",1,1)) ^ACHS(9,ACHSDUZ2,"FY",ACHSFY,"W",1,1)="0^0^0^0^0^0^0"

 S:'$D(^ACHS(9,ACHSDUZ2,"RN")) ^("RN")="HOSPITAL CARE^E.R. ROOM^PHYS INPATIENT^PHYS OUTPATIENT^DENTAL CARE^P&E TRAVEL^OTHER"

 Q

 ;

FI ; Set FI address.

 I $D(^ACHS(4,1,0)) Q

 W !,$$C^XBFUNC("Installing 'FISCAL AGENT' address...")

 S ^ACHS(4,1,0)="BLUE CROSS & BLUE SHIELD OF NM^P. O. BOX 13509^ALBUQUERQUE^35^87192-3509"

 ;

 Q

 ;

INDEX ; Index files just installed.

 W !,$$C^XBFUNC("Re-indexing all files just installed...")

 K DIK

 F ACHS=2,4,7,9 S DIK="^ACHS("_ACHS_"," W !,$$C^XBFUNC(DIK) D IXALL^DIK

 ;K DIK;IHS/SET/GTH ACHS*3.1*5 12/06/2002

 ;S DIK="^ACHSF(";IHS/SET/GTH ACHS*3.1*5 12/06/2002

 K DIK,DA ;IHS/SET/GTH ACHS*3.1*5 12/06/2002

 S DIK="^ACHSF(",DA=ACHSDUZ2 ;IHS/SET/GTH ACHS*3.1*5 12/06/2002

 W !,$$C^XBFUNC(DIK)

 ;D IXALL^DIK;IHS/SET/GTH ACHS*3.1*5 12/06/2002

 D IX1^DIK ;IHS/SET/GTH ACHS*3.1*5 12/06/2002

 Q

END ;

 K ACHS638,ACHSC,ACHSFY,ACHSI,ACHSK,ACHSO,ACHSSITE,ACHSZ,DA,DIC,DIE,DIK,DIR,DR

 Q

 ;

ACHSSTL   ; IHS/ITSC/PMF - CHS FACILITY PARAMETER SET UP;    [ 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 - Fix index to prevent overwrite of print Q for other facilities.

 +3        DO VIDEO^ACHS

 +4        SET ACHSDUZ2=""

 +5        WRITE @IOF,$GET(IORVON),!,$$REPEAT^XLFSTR("*",78)

 +6        WRITE !,"*",?77,"*",!

 +7        WRITE "*",?30,"CONTRACT HEALTH SYSTEM",?77,"*",!

 +8        WRITE "*",?31,"FACILITY PARAMETER SET UP",?77,"*",!

 +9        WRITE "*",?77,"*",!,$$REPEAT^XLFSTR("*",78),$GET(IORVOFF),!!

 +10       SET Y=$$DIR^XBDIR("PO^4:AEMQ","What Facility's Parameters Will You Be Entering")

 +11       IF (Y<1)!$DATA">DATA(DTOUT)!$DATA">DATA(DUOUT)

               GOTO END

 +12       SET ACHSDUZ2=+Y

 +13      ;

 +14       SET Y=$$DIR^XBDIR("YO","Is This Facility a 638 Facility","","","","",2)

 +15       IF Y=""!$DATA">DATA(DTOUT)!$DATA">DATA(DUOUT)

               GOTO END

 +16       IF Y=1

               SET ACHS638=""

 +17       IF Y=0

               KILL ACHS638

 +18      ;

 +19       DO LIST

           IF STOP

               DO END

               QUIT 

 +20      ;

 +21       DO STDPAR

 +22       DO ^ACHSSTL1

           DO ^ACHSSTL2

 +23       DO SIG

           DO DATA

           DO FI

 +24       DO INDEX

           DO END

 +25      ;

 +26      ;

 +27       WRITE !!!!!,"Install Complete!!",!!

 +28       QUIT 

LIST      ;

 +1        WRITE @IOF

 +2        WRITE !,$$REPEAT^XLFSTR("*",78)

 +3        WRITE !!,"You should know the following items before installing CHS",!

 +4        WRITE !,"Check With The CHS Department For The Information If You Don't Have It ",!

 +5        WRITE !,"1.  CHS Mailing Address (Street,City,State,Zip)"

 +6        WRITE !,"2.  The Start Date Of Your Fiscal Year If Not Oct 1 (638 Facilities Only)"

 +7        WRITE !,"3.  CHS Common Accounting Numbers And The Cost Center(s) For Each"

 +8        WRITE !,"4.  Values For Allowable Overpayment For Each Document Type"

 +9        WRITE !,"5.  Normal Amount That Each Document Can Be Issued For"

 +10       WRITE !,"6.  Absolute Maximum That Document Can Be Issued For"

 +11       WRITE !,"7.  Name(s) and Title(s) Of Person(s) Who Will Sign Documents"

 +12       WRITE !,"8.  Name and Address Of Fiscal Intermediary",!,"    (If Other Than Blue Cross/Blue Shield of New Mexico)"

 +13       WRITE !,"9.  Current Advice Of Allowance"

 +14       WRITE !,"10. List of High Volume Providers That Will Be Participating In That Program",!

 +15       WRITE $$REPEAT^XLFSTR("*",78),!

 +16       SET STOP='$$DIR^XBDIR("E")

 +17       QUIT 

 +18      ;

STDPAR    ;

 +1        IF $DATA(^ACHSF(ACHSDUZ2,2))

               QUIT 

 +2        WRITE !,$$C^XBFUNC("Installing standard parameters...")

 +3       ;

 +4        SET ^ACHSF(ACHSDUZ2,2)="^N^N^Y^Y^N^Y^Y^Y^N^Y^Y^N^N^N^N^N^N^P^N^1^N^N^N^N^N"

 +5        SET ^ACHSF(ACHSDUZ2,0)=ACHSDUZ2_"^^^^^1001^1^N^N^^^"

 +6        IF $DATA(ACHS638)

               Begin DoDot:1

 +7                SET $PIECE(^ACHSF(ACHSDUZ2,0),U,8)="Y"

 +8                SET Y=$$DIR^XBDIR("Y","Do You Wish To Edit The Fiscal Year Start Date (DEFAULT=OCT 1)","","","","",1)

 +9                IF 'Y

                       QUIT 

 +10               SET DIE="^ACHSF("

                   SET DA=ACHSDUZ2

                   SET DR="11.01;11.02"

 +11               DO ^DIE

 +12               QUIT 

               End DoDot:1

 +13      ;

 +14       SET ACHSFY=$EXTRACT(DT,1,3)

 +15       IF $PIECE(^ACHSF(ACHSDUZ2,0),U,6)<$EXTRACT(DT,4,7)

               SET ACHSFY=ACHSFY+1

 +16       SET ACHSFY=ACHSFY+1700

 +17       QUIT 

 +18      ;

SIG       ;

 +1        IF $DATA(^ACHSF(ACHSDUZ2,"P"))

               QUIT 

 +2        WRITE !!,"Enter Name and Title Of Person Signing Documents...",!!

 +3        SET DIE="^ACHSF("

           SET DA=+ACHSDUZ2

           SET DR="50;51;52"

 +4        DO ^DIE

 +5        QUIT 

 +6       ;

DATA      ;

 +1        IF $DATA(^ACHS(9,ACHSDUZ2))

               QUIT 

 +2        WRITE !,$$C^XBFUNC("Installing 'CHS DATA CONTROL FILE'...")

 +3        IF '$DATA(^ACHS(9,0))

               SET ^(0)="CHS DATA CONTROL^9002069P"

 +4        IF '$DATA(^ACHS(9,ACHSDUZ2,0))

               SET ^(0)=ACHSDUZ2_"^^1^1"

 +5        IF '$DATA(^ACHS(9,ACHSDUZ2,"FY",0))

               SET ^(0)="^9002069.01^"_ACHSFY_"^1"

 +6        IF '$DATA(^ACHS(9,ACHSDUZ2,"FY",ACHSFY,0))

               SET ^(0)=ACHSFY_"^0^0"

 +7        IF '$DATA(^ACHS(9,ACHSDUZ2,"FY",ACHSFY,1))

               SET ^(1)="0^0^0^0^0^0^0"

 +8        IF '$DATA(^ACHS(9,ACHSDUZ2,"FY",ACHSFY,"C"))

               SET ^("C")=0

 +9        IF '$DATA(^ACHS(9,ACHSDUZ2,"FY",ACHSFY,"W",0))

               SET ^(0)="^9002069.02A^1^1"

 +10       IF '$DATA(^ACHS(9,ACHSDUZ2,"FY",ACHSFY,"W",1,0))

               SET ^ACHS(9,ACHSDUZ2,"FY",ACHSFY,"W",1,0)=1

 +11       IF '$DATA(^ACHS(9,ACHSDUZ2,"FY",ACHSFY,"W",1,1))

               SET ^ACHS(9,ACHSDUZ2,"FY",ACHSFY,"W",1,1)="0^0^0^0^0^0^0"

 +12       IF '$DATA(^ACHS(9,ACHSDUZ2,"RN"))

               SET ^("RN")="HOSPITAL CARE^E.R. ROOM^PHYS INPATIENT^PHYS OUTPATIENT^DENTAL CARE^P&E TRAVEL^OTHER"

 +13       QUIT 

 +14      ;

FI        ; Set FI address.

 +1        IF $DATA(^ACHS(4,1,0))

               QUIT 

 +2        WRITE !,$$C^XBFUNC("Installing 'FISCAL AGENT' address...")

 +3        SET ^ACHS(4,1,0)="BLUE CROSS & BLUE SHIELD OF NM^P. O. BOX 13509^ALBUQUERQUE^35^87192-3509"

 +4       ;

 +5        QUIT 

 +6       ;

INDEX     ; Index files just installed.

 +1        WRITE !,$$C^XBFUNC("Re-indexing all files just installed...")

 +2        KILL DIK

 +3        FOR ACHS=2,4,7,9

               SET DIK="^ACHS("_ACHS_","

               WRITE !,$$C^XBFUNC(DIK)

               DO IXALL^DIK

 +4       ;K DIK;IHS/SET/GTH ACHS*3.1*5 12/06/2002

 +5       ;S DIK="^ACHSF(";IHS/SET/GTH ACHS*3.1*5 12/06/2002

 +6       ;IHS/SET/GTH ACHS*3.1*5 12/06/2002

           KILL DIK,DA

 +7       ;IHS/SET/GTH ACHS*3.1*5 12/06/2002

           SET DIK="^ACHSF("

           SET DA=ACHSDUZ2

 +8        WRITE !,$$C^XBFUNC(DIK)

 +9       ;D IXALL^DIK;IHS/SET/GTH ACHS*3.1*5 12/06/2002

 +10      ;IHS/SET/GTH ACHS*3.1*5 12/06/2002

           DO IX1^DIK

 +11       QUIT 

END       ;

 +1        KILL ACHS638,ACHSC,ACHSFY,ACHSI,ACHSK,ACHSO,ACHSSITE,ACHSZ,DA,DIC,DIE,DIK,DIR,DR

 +2        QUIT 

 +3       ;