ACHSSTL1.m

ACHSSTL1 ; IHS/ITSC/PMF - INSTALL A NEW SITE'S COST CENTERS ;   [ 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 - Don't setup COST CENTERs if already setup.

 Q:'$D(DUZ(2))

 D HOME^%ZIS

 S ACHSSITE=$$LOC^ACHS

SETCTR ;

 K DIC,DIE,DA,DR

 I $P(^ACHS(1,0),U,3) W !!,"CHS COST CENTER file is already Setup." D END Q  ;IHS/SET/GTH ACHS*3.1*5 12/06/2002

 W *7,!!!,"Setting up the CHS COST CENTER file.",!!

 D WAIT^DICD

 W !!

 S ^ACHS(1,0)="CHS COST CENTER^9002061I^"

CC1 ;

 F ACHSI=1:1 S ACHSZ=$S($D(ACHS638):$T(@"COST638"+ACHSI),1:$T(@"COSTIHS"+ACHSI)) Q:ACHSZ=" ;;"  D

 . S DIC="^ACHS(1,",DIC(0)="L",X=$E(ACHSZ,4,6),DLAYGO=9002061,DIC("DR")="1///"_$P(ACHSZ,U,2)

 . D ^DIC

 . W "."

 .Q

 W !!,"Done!!"

END ;

 K DIE,DIC,DA,DLAYGO,DR,ACHSI,ACHSZ,ACHSK,ACHSC,X

 Q

COSTIHS ;;

 ;;240^PHY SVCS IN IHS FACILITY

 ;;526^PATIENT & ESCORT TRAVEL

 ;;533^RENAL DIALYSIS (NON IHS)

 ;;568^DENTAL SERVICES

 ;;573^CHS GM & S HOSP

 ;;574^CHS AMBULATORY CARE

 ;;575^CHS ALL OTHER/REHAB

 ;;

COST638 ;;

 ;;573^CHS GM & S HOSP

 ;;

ACHSSTL1  ; IHS/ITSC/PMF - INSTALL A NEW SITE'S COST CENTERS ;   [ 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 - Don't setup COST CENTERs if already setup.

 +3        IF '$DATA(DUZ(2))

               QUIT 

 +4        DO HOME^%ZIS

 +5        SET ACHSSITE=$$LOC^ACHS

SETCTR    ;

 +1        KILL DIC,DIE,DA,DR

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

           IF $PIECE(^ACHS(1,0),U,3)

               WRITE !!,"CHS COST CENTER file is already Setup."

               DO END

               QUIT 

 +3        WRITE *7,!!!,"Setting up the CHS COST CENTER file.",!!

 +4        DO WAIT^DICD

 +5        WRITE !!

 +6        SET ^ACHS(1,0)="CHS COST CENTER^9002061I^"

CC1       ;

 +1        FOR ACHSI=1:1

               SET ACHSZ=$SELECT($DATA(ACHS638):$TEXT(@"COST638"+ACHSI),1:$TEXT(@"COSTIHS"+ACHSI))

               IF ACHSZ=" ;;"

                   QUIT 

               Begin DoDot:1

 +2                SET DIC="^ACHS(1,"

                   SET DIC(0)="L"

                   SET X=$EXTRACT(ACHSZ,4,6)

                   SET DLAYGO=9002061

                   SET DIC("DR")="1///"_$PIECE(ACHSZ,U,2)

 +3                DO ^DIC

 +4                WRITE "."

 +5                QUIT 

               End DoDot:1

 +6        WRITE !!,"Done!!"

END       ;

 +1        KILL DIE,DIC,DA,DLAYGO,DR,ACHSI,ACHSZ,ACHSK,ACHSC,X

 +2        QUIT 

COSTIHS   ;;

 +1       ;;240^PHY SVCS IN IHS FACILITY

 +2       ;;526^PATIENT & ESCORT TRAVEL

 +3       ;;533^RENAL DIALYSIS (NON IHS)

 +4       ;;568^DENTAL SERVICES

 +5       ;;573^CHS GM & S HOSP

 +6       ;;574^CHS AMBULATORY CARE

 +7       ;;575^CHS ALL OTHER/REHAB

 +8       ;;

COST638   ;;

 +1       ;;573^CHS GM & S HOSP

 +2       ;;