ACHSYES.m

ACHSYES ; IHS/ITSC/PMF - REGENERATE "ES" CROSSREF OF CHS FACILITY FROM GIVEN IEN ;  [ 10/16/2001   8:16 AM ]

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

 ;

 ; This utility rebuilds the "ES" x-ref (ESTIMATED DATE OF SERVICE),

 ; in the CHS FACILITY file.

 ;

 ; DUZ & DUZ(2) must be defined.

 ;

 ; You'll be asked for the beginning internal entry number at the "D"

 ; level of the ^ACHSF(DUZ(2),"D", global.  The re-build will begin

 ; with that entry and proceed to the last entry number.

 ;

 ; The entire file can be x-ref'd using FM x-ref utility,

 ; CHS FACILITY file, DOCUMENT sub-file, ESTIMATED DATE

 ; OF SERVICE field, "ES" x-ref.

 ;

 I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." Q

 I '$G(DUZ(2)) W !,"DUZ(2) UNDEFINED OR 0." Q

 D HOME^%ZIS,DT^DICRW

START ;

 S Y=$$DIR^XBDIR("NO^1:"_$P(^ACHSF(DUZ(2),"D",0),U,3),"ENTER BEGINNING IEN")

 Q:'Y

 D WAIT^DICD

 N D,E

 S D=+Y

 F  S D=$O(^ACHSF(DUZ(2),"D",D)) Q:'D  S E=$P($G(^ACHSF(DUZ(2),"D",D,3)),U,9) W "." I E]"" S ^ACHSF(DUZ(2),"ES",E,D)=""

 Q

 ;

ACHSYES   ; IHS/ITSC/PMF - REGENERATE "ES" CROSSREF OF CHS FACILITY FROM GIVEN IEN ;  [ 10/16/2001   8:16 AM ]

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

 +2       ;

 +3       ; This utility rebuilds the "ES" x-ref (ESTIMATED DATE OF SERVICE),

 +4       ; in the CHS FACILITY file.

 +5       ;

 +6       ; DUZ & DUZ(2) must be defined.

 +7       ;

 +8       ; You'll be asked for the beginning internal entry number at the "D"

 +9       ; level of the ^ACHSF(DUZ(2),"D", global.  The re-build will begin

 +10      ; with that entry and proceed to the last entry number.

 +11      ;

 +12      ; The entire file can be x-ref'd using FM x-ref utility,

 +13      ; CHS FACILITY file, DOCUMENT sub-file, ESTIMATED DATE

 +14      ; OF SERVICE field, "ES" x-ref.

 +15      ;

 +16       IF '$GET(DUZ)

               WRITE !,"DUZ UNDEFINED OR 0."

               QUIT 

 +17       IF '$GET(DUZ(2))

               WRITE !,"DUZ(2) UNDEFINED OR 0."

               QUIT 

 +18       DO HOME^%ZIS

           DO DT^DICRW

START     ;

 +1        SET Y=$$DIR^XBDIR("NO^1:"_$PIECE(^ACHSF(DUZ(2),"D",0),U,3),"ENTER BEGINNING IEN")

 +2        IF 'Y

               QUIT 

 +3        DO WAIT^DICD

 +4        NEW D,E

 +5        SET D=+Y

 +6        FOR 

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

               IF 'D

                   QUIT 

               SET E=$PIECE($GET(^ACHSF(DUZ(2),"D",D,3)),U,9)

               WRITE "."

               IF E]""

                   SET ^ACHSF(DUZ(2),"ES",E,D)=""

 +7        QUIT 

 +8       ;