- 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
