ACHSR.m

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

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

 ;

 Q

 ;

 ;

FOO ;

 S FAC=0 F  S FAC=$O(^ACHSF(FAC)) Q:FAC=""  D

 . S A="XPR" F  S A=$O(^ACHSF(FAC,A)) Q:A=""  Q:$E(A,1,4)'="XPRT"  W !,A  K ^(A)

 . Q

 ;

 S A="" F  S A=$O(^ACHSXPRT(A)) Q:A=""  K ^(A)

 W !,"ACHSXPRT killed"

 ;

 W !!

 K ^ACHSTXST(4)

 S PMF="" F  S PMF=$O(^ACHSTXST(PMF)) Q:PMF=""  K ^ACHSTXST(PMF,4) S PMF2="" F  S PMF2=$O(^ACHSTXST(PMF,PMF2)) Q:PMF2=""  K ^ACHSTXST(PMF,PMF2,4)

 ;

 Q

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

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

 +2       ;

 +3        QUIT 

 +4       ;

 +5       ;

FOO       ;

 +1        SET FAC=0

           FOR 

               SET FAC=$ORDER(^ACHSF(FAC))

               IF FAC=""

                   QUIT 

               Begin DoDot:1

 +2                SET A="XPR"

                   FOR 

                       SET A=$ORDER(^ACHSF(FAC,A))

                       IF A=""

                           QUIT 

                       IF $EXTRACT(A,1,4)'="XPRT"

                           QUIT 

                       WRITE !,A

                       KILL ^(A)

 +3                QUIT 

               End DoDot:1

 +4       ;

 +5        SET A=""

           FOR 

               SET A=$ORDER(^ACHSXPRT(A))

               IF A=""

                   QUIT 

               KILL ^(A)

 +6        WRITE !,"ACHSXPRT killed"

 +7       ;

 +8        WRITE !!

 +9        KILL ^ACHSTXST(4)

 +10       SET PMF=""

           FOR 

               SET PMF=$ORDER(^ACHSTXST(PMF))

               IF PMF=""

                   QUIT 

               KILL ^ACHSTXST(PMF,4)

               SET PMF2=""

               FOR 

                   SET PMF2=$ORDER(^ACHSTXST(PMF,PMF2))

                   IF PMF2=""

                       QUIT 

                   KILL ^ACHSTXST(PMF,PMF2,4)

 +11      ;

 +12       QUIT