USRPROV.m

USRPROV ; SLC/DJP - Auto-populate PROVIDER CLASS ;05/05/98

 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**7**;Jun 20, 1997

MAIN ; Main loop

 N USRDFN,USRNOW

 S USRDFN=0

 I +$G(^USR(8930.3,"USRPROV")) D  Q

 . W !!,"This option has already been run...Aborting option.",!

 W !!,"Initializing the PROVIDER Class"

 F  S USRDFN=$O(^XUSEC("PROVIDER",USRDFN)) Q:+USRDFN'>0  D

 . S USRNOW=$$NOW^XLFDT

 . ; Exclude terminated users

 . I +$P($G(^VA(200,USRDFN,0)),U,11)>0,(+$P($G(^(0)),U,11)<USRNOW) Q

 . S USRNM=$P($G(^VA(200,USRDFN,0)),U)

 . ; Exclude users w/o names or "ZZ" users

 . I (USRNM']"")!($E(USRNM,1,2)="ZZ") Q

 . D PUT^USRLM(USRDFN,"PROVIDER") W "."

 S ^USR(8930.3,"USRPROV")=1

 Q

USRPROV   ; SLC/DJP - Auto-populate PROVIDER CLASS ;05/05/98

 +1       ;;1.0;AUTHORIZATION/SUBSCRIPTION;**7**;Jun 20, 1997

MAIN      ; Main loop

 +1        NEW USRDFN,USRNOW

 +2        SET USRDFN=0

 +3        IF +$GET(^USR(8930.3,"USRPROV"))

               Begin DoDot:1

 +4                WRITE !!,"This option has already been run...Aborting option.",!

               End DoDot:1

               QUIT 

 +5        WRITE !!,"Initializing the PROVIDER Class"

 +6        FOR 

               SET USRDFN=$ORDER(^XUSEC("PROVIDER",USRDFN))

               IF +USRDFN'>0

                   QUIT 

               Begin DoDot:1

 +7                SET USRNOW=$$NOW^XLFDT

 +8       ; Exclude terminated users

 +9                IF +$PIECE($GET(^VA(200,USRDFN,0)),U,11)>0

                       IF (+$PIECE($GET(^(0)),U,11)<USRNOW)

                           QUIT 

 +10               SET USRNM=$PIECE($GET(^VA(200,USRDFN,0)),U)

 +11      ; Exclude users w/o names or "ZZ" users

 +12               IF (USRNM']"")!($EXTRACT(USRNM,1,2)="ZZ")

                       QUIT 

 +13               DO PUT^USRLM(USRDFN,"PROVIDER")

                   WRITE "."

               End DoDot:1

 +14       SET ^USR(8930.3,"USRPROV")=1

 +15       QUIT