Routine: ACHSYCN

ACHSYCN ; IHS/ITSC/PMF - RETRANSMIT BY TRANS CODE AND DATE ;    [ 10/16/2001   8:16 AM ]

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

 ;formally named ACHSZZ01

 D INIT

 S IEN=0

 F  S IEN=$O(^ACHS(2,IEN)) Q:'IEN  D  ; LOOP THROUGH CANS

 . S D=$G(^ACHS(2,IEN,0)) ; THE WHOLE THING

 . S CAN=$P(D,U,1) ; GET THE CAN

 . I "DQG"[$E(CAN,5) D SET ; WE HAVE A 1998,1999 OR 2000 CAN

 QUIT

INIT ; SET UP THE IMPORTANT VARIABLES

 S U="^"

 D ^XBKVAR ; DUZ AND OTHER STUFF

 QUIT

SET ;

 S C=$E(CAN,5) ; THE YEAR CODE

 S X=$S(C="Q":1998,C="D":1999,C="G":2000,1:0)

 I X=0 Q  ; DON'T KNOW WHAT HAPPENED BUT THIS IS BAD

 W !,CAN," = ",X

 S DLAYGO=9002062

 S DIC(0)="L" ; LAYGO A FISCAL YEAR

 S DIC="^ACHS(2,"_IEN_",1," ; ROOT REF TO SUB FILE FOR FISCAL YEAR

 S DA(1)=IEN ; THIS MUST BE SET FOR FILEMAN TO WORK

 S DIC("P")=$P(^DD(DLAYGO,4,0),U,2) ; FOR SUBFILE SETUP TO WORK

 D ^DIC ; LOOK AND SEE IF WE ALREADY HAVE THIS ENTRY

 W " ... FY ",$S($P(Y,U,3):"SET",1:"EXISTS")

 QUIT

ACHSYCN   ; IHS/ITSC/PMF - RETRANSMIT BY TRANS CODE AND DATE ;    [ 10/16/2001   8:16 AM ]

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

 +2       ;

 +3       ;formally named ACHSZZ01

 +4       ;

 +5        DO INIT

 +6        SET IEN=0

 +7       ; LOOP THROUGH CANS

FOR

               SET IEN=$ORDER(^ACHS(2,IEN))

               IF 'IEN

                   QUIT

               Begin DoDot:1

 +8       ; THE WHOLE THING

                   SET D=$GET(^ACHS(2,IEN,0))

 +9       ; GET THE CAN

                   SET CAN=$PIECE(D,U,1)

 +10      ; WE HAVE A 1998,1999 OR 2000 CAN

                   IF "DQG"[$EXTRACT(CAN,5)

                       DO SET

               End DoDot:1

 +11       QUIT

INIT      ; SET UP THE IMPORTANT VARIABLES

 +1        SET U="^"

 +2       ; DUZ AND OTHER STUFF

           DO ^XBKVAR

 +3        QUIT

SET       ;

 +1       ; THE YEAR CODE

           SET C=$EXTRACT(CAN,5)

 +2        SET X=$SELECT(C="Q":1998,C="D":1999,C="G":2000,1:0)

 +3       ; DON'T KNOW WHAT HAPPENED BUT THIS IS BAD

           IF X=0

               QUIT

 +4        WRITE !,CAN," = ",X

 +5        SET DLAYGO=9002062

 +6       ; LAYGO A FISCAL YEAR

           SET DIC(0)="L"

 +7       ; ROOT REF TO SUB FILE FOR FISCAL YEAR

           SET DIC="^ACHS(2,"_IEN_",1,"

 +8       ; THIS MUST BE SET FOR FILEMAN TO WORK

           SET DA(1)=IEN

 +9       ; FOR SUBFILE SETUP TO WORK

           SET DIC("P")=$PIECE(^DD(DLAYGO,4,0),U,2)

 +10      ; LOOK AND SEE IF WE ALREADY HAVE THIS ENTRY

           DO ^DIC

 +11       WRITE " ... FY ",$SELECT($PIECE(Y,U,3):"SET",1:"EXISTS")

 +12       QUIT

ACHSYCN.m