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 ;
