ACHSR1.m

ACHSR1 ; IHS/ITSC/PMF - for export testing   [ 10/16/2001   8:16 AM ]

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

 ;

 ;

 N A,B,C1,C2,C,D,II,PMF

 ;

 S A="XPRT4"

 ;

 S B=$O(^ACHSF(DUZ(2),A,""))

 ;

 I B="" Q

 ;

 S C="" F II=1:1:2 S PMF="C"_II S C=$O(^ACHSF(DUZ(2),A,B,C)) Q:C=""  S @PMF=C

 ;W !,C1,!,C2,! R PMF

 ;

 I $G(C1)="" Q

 I $G(C2)="" Q

 ;

 S B="" F  S B=$O(^ACHSF(DUZ(2),A,B)) Q:B=""  D C

 ;

 W !

 ;

 F C=C1,C2 S B="" F  S B=$O(^ACHSF(DUZ(2),A,B)) Q:B=""  I $O(^ACHSF(DUZ(2),A,B,C,""))="" W " .." K ^ACHSF(DUZ(2),A,B,C)

 ;

 Q

 S A="ACHS6"

 S B="" F  S B=$O(^ACHSF(DUZ(2),A,B)) Q:B=""  D C2

 Q

C ;

 S D="" F  S D=$O(^ACHSF(DUZ(2),A,B,C1,D)) Q:D=""  I $D(^ACHSF(DUZ(2),A,B,C2,D)) W " ." K ^ACHSF(DUZ(2),A,B,C1,D),^ACHSF(DUZ(2),A,B,C2,D)

 Q

 ;

C2 ;

 S D="" F  S D=$O(^ACHSF(DUZ(2),A,B,D)) Q:D=""  D C3

 Q

C3 ;

 S CC1=C1,CC2=C2 D C4

 S CC1=C2,CC2=C1 D C4

 Q

C4 ;

 S E="" F  S E=$O(^ACHSF(DUZ(2),A,B,D,CC1,E)) Q:E=""  D C5

 Q

C5 ;

 S F="" F  S F=$O(^ACHSF(DUZ(2),A,B,D,CC2,F)) Q:F=""  D

 . I E=F K ^ACHSF(DUZ(2),A,B,D,CC1,E),^ACHSF(DUZ(2),A,B,D,CC2,E) W ". "

 . Q

 Q

ACHSR1    ; IHS/ITSC/PMF - for export testing   [ 10/16/2001   8:16 AM ]

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

 +2       ;

 +3       ;

 +4        NEW A,B,C1,C2,C,D,II,PMF

 +5       ;

 +6        SET A="XPRT4"

 +7       ;

 +8        SET B=$ORDER(^ACHSF(DUZ(2),A,""))

 +9       ;

 +10       IF B=""

               QUIT 

 +11      ;

 +12       SET C=""

           FOR II=1:1:2

               SET PMF="C"_II

               SET C=$ORDER(^ACHSF(DUZ(2),A,B,C))

               IF C=""

                   QUIT 

               SET @PMF=C

 +13      ;W !,C1,!,C2,! R PMF

 +14      ;

 +15       IF $GET(C1)=""

               QUIT 

 +16       IF $GET(C2)=""

               QUIT 

 +17      ;

 +18       SET B=""

           FOR 

               SET B=$ORDER(^ACHSF(DUZ(2),A,B))

               IF B=""

                   QUIT 

               DO C

 +19      ;

 +20       WRITE !

 +21      ;

 +22       FOR C=C1,C2

               SET B=""

               FOR 

                   SET B=$ORDER(^ACHSF(DUZ(2),A,B))

                   IF B=""

                       QUIT 

                   IF $ORDER(^ACHSF(DUZ(2),A,B,C,""))=""

                       WRITE " .."

                       KILL ^ACHSF(DUZ(2),A,B,C)

 +23      ;

 +24       QUIT 

 +25       SET A="ACHS6"

 +26       SET B=""

           FOR 

               SET B=$ORDER(^ACHSF(DUZ(2),A,B))

               IF B=""

                   QUIT 

               DO C2

 +27       QUIT 

C         ;

 +1        SET D=""

           FOR 

               SET D=$ORDER(^ACHSF(DUZ(2),A,B,C1,D))

               IF D=""

                   QUIT 

               IF $DATA(^ACHSF(DUZ(2),A,B,C2,D))

                   WRITE " ."

                   KILL ^ACHSF(DUZ(2),A,B,C1,D),^ACHSF(DUZ(2),A,B,C2,D)

 +2        QUIT 

 +3       ;

C2        ;

 +1        SET D=""

           FOR 

               SET D=$ORDER(^ACHSF(DUZ(2),A,B,D))

               IF D=""

                   QUIT 

               DO C3

 +2        QUIT 

C3        ;

 +1        SET CC1=C1

           SET CC2=C2

           DO C4

 +2        SET CC1=C2

           SET CC2=C1

           DO C4

 +3        QUIT 

C4        ;

 +1        SET E=""

           FOR 

               SET E=$ORDER(^ACHSF(DUZ(2),A,B,D,CC1,E))

               IF E=""

                   QUIT 

               DO C5

 +2        QUIT 

C5        ;

 +1        SET F=""

           FOR 

               SET F=$ORDER(^ACHSF(DUZ(2),A,B,D,CC2,F))

               IF F=""

                   QUIT 

               Begin DoDot:1

 +2                IF E=F

                       KILL ^ACHSF(DUZ(2),A,B,D,CC1,E),^ACHSF(DUZ(2),A,B,D,CC2,E)

                       WRITE ". "

 +3                QUIT 

               End DoDot:1

 +4        QUIT