AUTPOS3.m

AUTPOS3 ; IHS/DIRM/JDM/DFM - Post Init to AUT ;  [ 03/04/98   8:10 AM ]

 ;;98.1;IHS DICTIONARIES (POINTERS);;MAR 04, 1998;Build 6

 ;

 ;

RECODE ;EP - Converts invalid phone #s to valid in INSURER file.

 S NX=0 D CONVRT

 Q

CONVRT ;

 Q:'$O(^AUTNINS(NX))

 S NX=$O(^AUTNINS(NX))

 S PN=$P(^AUTNINS(NX,0),U,6)

 S LN=$L(PN)

 Q:PN=""!(LN<13)

 I $E(PN,6)="-" S PN=$P(PN,"-",1)_$P(PN,"-",2)

 S DIE="^AUTNINS(",DA=NX,DR=".06//^S X=PN" D ^DIE

 G CONVRT

 Q

AUTPOS3   ; IHS/DIRM/JDM/DFM - Post Init to AUT ;  [ 03/04/98   8:10 AM ]

 +1       ;;98.1;IHS DICTIONARIES (POINTERS);;MAR 04, 1998;Build 6

 +2       ;

 +3       ;

RECODE    ;EP - Converts invalid phone #s to valid in INSURER file.

 +1        SET NX=0

           DO CONVRT

 +2        QUIT 

CONVRT    ;

 +1        IF '$ORDER(^AUTNINS(NX))

               QUIT 

 +2        SET NX=$ORDER(^AUTNINS(NX))

 +3        SET PN=$PIECE(^AUTNINS(NX,0),U,6)

 +4        SET LN=$LENGTH(PN)

 +5        IF PN=""!(LN<13)

               QUIT 

 +6        IF $EXTRACT(PN,6)="-"

               SET PN=$PIECE(PN,"-",1)_$PIECE(PN,"-",2)

 +7        SET DIE="^AUTNINS("

           SET DA=NX

           SET DR=".06//^S X=PN"

           DO ^DIE

 +8        GOTO CONVRT

 +9        QUIT