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 Dec 13, 2024@01:39 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
