- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HUSRPROV 691 printed Feb 18, 2025@23:05:23 Page 2
- 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