ACHSPCC6.m

ACHSPCC6 ; IHS/ITSC/PMF - COPY ^ACHSPCC GLOBAL TO ^ACHSBCBS GLOBAL ;   [ 10/16/2001   8:16 AM ]

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

 ;

 W !!,"NOT AN ENTRY POINT"

 Q

 ;

COPY ;EP - Copy DHR records for export to the FI (Inactive, 04-17-96).

 N X,Y,Z

 W !!,"COPYING DHR RECORD TYPE 2 RECORDS FOR EXPORT TO BCBS.",!

 S Z=500000,(X,Y)=0

COPY1 ;

 S X=$O(^ACHSPCC(X))

 G COPYEND:+X=0

 S Y=0

COPY2 ;

 S Y=$O(^ACHSPCC(X,Y))

 G COPY1:+Y=0

 S Z=Z+1,^ACHSBCBS(Z)=$G(^ACHSPCC(X,Y))

 G COPY2

 ;

COPYEND ;

 U IO(0)

 W !!,Z-500000," TYPE 2 RECORDS COPIED TO BLUE-CROSS FILE",!!

 Q

 ;

ACHSPCC6  ; IHS/ITSC/PMF - COPY ^ACHSPCC GLOBAL TO ^ACHSBCBS GLOBAL ;   [ 10/16/2001   8:16 AM ]

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

 +2       ;

 +3        WRITE !!,"NOT AN ENTRY POINT"

 +4        QUIT 

 +5       ;

COPY      ;EP - Copy DHR records for export to the FI (Inactive, 04-17-96).

 +1        NEW X,Y,Z

 +2        WRITE !!,"COPYING DHR RECORD TYPE 2 RECORDS FOR EXPORT TO BCBS.",!

 +3        SET Z=500000

           SET (X,Y)=0

COPY1     ;

 +1        SET X=$ORDER(^ACHSPCC(X))

 +2        IF +X=0

               GOTO COPYEND

 +3        SET Y=0

COPY2     ;

 +1        SET Y=$ORDER(^ACHSPCC(X,Y))

 +2        IF +Y=0

               GOTO COPY1

 +3        SET Z=Z+1

           SET ^ACHSBCBS(Z)=$GET(^ACHSPCC(X,Y))

 +4        GOTO COPY2

 +5       ;

COPYEND   ;

 +1        USE IO(0)

 +2        WRITE !!,Z-500000," TYPE 2 RECORDS COPIED TO BLUE-CROSS FILE",!!

 +3        QUIT 

 +4       ;