ACHSSDA.m

ACHSSDA ;IHS/OIT/FCJ - ADD DATA TO CHS SERV DEL AREA FILE

 ;;3.1;CONTRACT HEALTH MANAGEMENT SYSTEM;**18**;JUNE 11,2001

 ;ACHS*3.1*18 NEW ROUTINE

 ;

ADD ;ADD DATA TO THE CHS SERVICE DELIVERY AREA FILE

 S ACHST=0,CT=0

 F  S ACHST=$O(^ACHSTMP(ACHST)) Q:ACHST'?1N.N  D

 .S ACHSTRC=$P(^ACHSTMP(ACHST),U,2)

 .S X=$O(^AUTTTRI("C",ACHSTRC,0))

 .I 'X S $P(^ACHSTMP(ACHST),U,3)="NOT FOUND" Q

 .S CT=CT+1

 .S ^ACHSSDA(ACHST,0)=X,^ACHSSDA("B",X,ACHST)=""

 .S ACHSC=0,CT1=0 F  S ACHSC=$O(^ACHSTMP(ACHST,ACHSC)) Q:ACHSC'?1N.N  D

 ..S ACHSCC=$P(^ACHSTMP(ACHST,ACHSC),U)

 ..S X1=$O(^AUTTCTY("C",ACHSCC,0))

 ..I 'X1 S $P(^ACHSTMP(ACHST,ACHSC),U,2)="NOT FOUND" Q

 ..S CT1=CT1+1

 ..S ^ACHSSDA(ACHST,30,CT1,0)=X1,^ACHSSDA(ACHST,30,"B",X1,CT1)=""

 .I CT1>0 S ^ACHSSDA(ACHST,30,0)="^9002073.31P^"_CT1_U_CT1

 S $P(^ACHSSDA(0),U,3,4)=CT_U_CT

 K ACHST,ACHSTRC,ACHSC,ACHSCC,CT,CT1,X,X1

TMP ;SET TMP FILE FROM THE ACHSSDA GLOBAL

 S ACHSIEN=0,CT=0

 F  S ACHSIEN=$O(^ACHSSDA(ACHSIEN)) Q:ACHSIEN'?1N.N  D

 .S CT=CT+1

 .S ^ACHSTMP(CT)=$P(^AUTTTRI($P(^ACHSSDA(ACHSIEN,0),U),0),U,1,2)

 .S ACHSCTY=0,CT1=0 F  S ACHSCTY=$O(^ACHSSDA(ACHSIEN,30,ACHSCTY)) Q:ACHSCTY'?1N.N  D

 ..S CT1=CT1+1

 ..S ACHSC=$P(^ACHSSDA(ACHSIEN,30,ACHSCTY,0),U)

 ..S ^ACHSTMP(CT,CT1)=$P(^AUTTCTY(ACHSC,0),U,4)

 Q

ACHSSDA   ;IHS/OIT/FCJ - ADD DATA TO CHS SERV DEL AREA FILE

 +1       ;;3.1;CONTRACT HEALTH MANAGEMENT SYSTEM;**18**;JUNE 11,2001

 +2       ;ACHS*3.1*18 NEW ROUTINE

 +3       ;

ADD       ;ADD DATA TO THE CHS SERVICE DELIVERY AREA FILE

 +1        SET ACHST=0

           SET CT=0

 +2        FOR 

               SET ACHST=$ORDER(^ACHSTMP(ACHST))

               IF ACHST'?1N.N

                   QUIT 

               Begin DoDot:1

 +3                SET ACHSTRC=$PIECE(^ACHSTMP(ACHST),U,2)

 +4                SET X=$ORDER(^AUTTTRI("C",ACHSTRC,0))

 +5                IF 'X

                       SET $PIECE(^ACHSTMP(ACHST),U,3)="NOT FOUND"

                       QUIT 

 +6                SET CT=CT+1

 +7                SET ^ACHSSDA(ACHST,0)=X

                   SET ^ACHSSDA("B",X,ACHST)=""

 +8                SET ACHSC=0

                   SET CT1=0

                   FOR 

                       SET ACHSC=$ORDER(^ACHSTMP(ACHST,ACHSC))

                       IF ACHSC'?1N.N

                           QUIT 

                       Begin DoDot:2

 +9                        SET ACHSCC=$PIECE(^ACHSTMP(ACHST,ACHSC),U)

 +10                       SET X1=$ORDER(^AUTTCTY("C",ACHSCC,0))

 +11                       IF 'X1

                               SET $PIECE(^ACHSTMP(ACHST,ACHSC),U,2)="NOT FOUND"

                               QUIT 

 +12                       SET CT1=CT1+1

 +13                       SET ^ACHSSDA(ACHST,30,CT1,0)=X1

                           SET ^ACHSSDA(ACHST,30,"B",X1,CT1)=""

                       End DoDot:2

 +14               IF CT1>0

                       SET ^ACHSSDA(ACHST,30,0)="^9002073.31P^"_CT1_U_CT1

               End DoDot:1

 +15       SET $PIECE(^ACHSSDA(0),U,3,4)=CT_U_CT

 +16       KILL ACHST,ACHSTRC,ACHSC,ACHSCC,CT,CT1,X,X1

TMP       ;SET TMP FILE FROM THE ACHSSDA GLOBAL

 +1        SET ACHSIEN=0

           SET CT=0

 +2        FOR 

               SET ACHSIEN=$ORDER(^ACHSSDA(ACHSIEN))

               IF ACHSIEN'?1N.N

                   QUIT 

               Begin DoDot:1

 +3                SET CT=CT+1

 +4                SET ^ACHSTMP(CT)=$PIECE(^AUTTTRI($PIECE(^ACHSSDA(ACHSIEN,0),U),0),U,1,2)

 +5                SET ACHSCTY=0

                   SET CT1=0

                   FOR 

                       SET ACHSCTY=$ORDER(^ACHSSDA(ACHSIEN,30,ACHSCTY))

                       IF ACHSCTY'?1N.N

                           QUIT 

                       Begin DoDot:2

 +6                        SET CT1=CT1+1

 +7                        SET ACHSC=$PIECE(^ACHSSDA(ACHSIEN,30,ACHSCTY,0),U)

 +8                        SET ^ACHSTMP(CT,CT1)=$PIECE(^AUTTCTY(ACHSC,0),U,4)

                       End DoDot:2

               End DoDot:1

 +9        QUIT