APCDPTAB ; IHS/CMI/LAB - Provider table print
;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
;
;
;
EP ;EP - called from option interactive
D EOJ
W:$D(IOF) @IOF
S APCDTEXT="INTROT" F APCDJ=1:1 S APCDX=$T(@APCDTEXT+APCDJ) Q:$P(APCDX,";;",2)="END" S APCDT=$P(APCDX,";;",2) W !,APCDT
PROVKEY ;
K APCDTRIM S APCDTRIT=""
S DIR(0)="S^A:All Users;P:Providers Only (defined by having the PROVIDER key)",DIR("A")="List which set of entries",DIR("B")="P" K DA D ^DIR K DIR
I $D(DIRUT) G EOJ
S APCDPKEY=Y
ACTIVE ;
K APCDSTAT
S DIR(0)="S^A:Active Providers;I:Inactive Providers;B:Both Active and Inactive Providers",DIR("A")="List which set of providers",DIR("B")="A" K DA D ^DIR K DIR
I $D(DIRUT) G PROVKEY
S APCDSTAT=Y,APCDSTAN=Y(0)
AFFL ;
K APCDAFFM S APCDAFFT=""
S DIR(0)="S^O:One or a Set of Affiliations;A:Any/All Affiliations",DIR("A")="Include Providers with which Affiliation",DIR("B")="A" K DA D ^DIR K DIR
I $D(DIRUT) G ACTIVE
S APCDAFFT=Y
I APCDAFFT="A" W !!,"Providers of all affiliations will be included in the report.",! G DISC
S X="AFFILIATION",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" S APCDERR=1 D EOJ Q Q
D PEP^AMQQGTX0(+Y,"APCDAFFM(")
I '$D(APCDAFFM) G AFFL
I $D(APCDAFFM("*")) K APCDAFFM G AFFL
DISC ;
K APCDDISM S APCDDIST=""
S DIR(0)="S^O:One or a Set of Disciplines/Provider Classes;A:Any/All Disciplines/Provider Classes",DIR("A")="Include Providers with which Provider Class",DIR("B")="A" K DA D ^DIR K DIR
I $D(DIRUT) G ACTIVE
S APCDDIST=Y
I APCDDIST="A" W !!,"Providers of all Disciplines will be included in the report.",! G DIVC
S X="DISCIPLINE",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" S APCDERR=1 D EOJ Q Q
D PEP^AMQQGTX0(+Y,"APCDDISM(")
I '$D(APCDDISM) G DISC
I $D(APCDDISM("*")) K APCDDISM G DISC
DIVC ;
W !!,"You can select just providers who have access to a particular"
W !,"division. Since there is no designation in file 200 to specify"
W !,"which facility a provider works knowing which Division they have"
W !,"access to may help determine where they work."
W !
K APCDDIVM S APCDDIVT=""
S DIR(0)="S^O:One or a Set of Divisions/Locations;A:Any/All Divisions/Locations",DIR("A")="Include Providers with access to which division",DIR("B")="A" K DA D ^DIR K DIR
I $D(DIRUT) G ACTIVE
S APCDDIVT=Y
I APCDDIVT="A" W !!,"All will be included in the report.",! G SORTR
S X="LOCATION OF ENCOUNTER",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" S APCDERR=1 D EOJ Q Q
D PEP^AMQQGTX0(+Y,"APCDDIVM(")
I '$D(APCDDIVM) G DIVC
I $D(APCDDIVM("*")) K APCDDIVM G DIVC
SORTR ;
S APCDSORT=""
S DIR(0)="S^N:Provider Name;A:Affiliation;D:Discipline/Class;S:Active/Inactive Status",DIR("A")="Sort the list by",DIR("B")="N"
KILL DA D ^DIR KILL DIR
I $D(DIRUT) G DIVC
S APCDSORT=Y
ZIS ;
S XBRP="PRINT^APCDPTAB",XBRC="PROC^APCDPTAB",XBRX="EOJ^APCDPTAB",XBNS="APCD"
D ^XBDBQUE
Q
EOJ ;
D ^XBFMK
K DIC,DIR
D EN^XBVK("APCD")
Q
;
PROC ;
S APCDJ=$J,APCDH=$H
K ^XTMP("APCDPTAB",APCDJ,APCDH)
S ^XTMP("APCDPTAB",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"PCC PROVIDER REPORT"
S APCDIEN=0 F S APCDIEN=$O(^VA(200,APCDIEN)) Q:APCDIEN'=+APCDIEN D
.I APCDPKEY="P",'$D(^XUSEC("PROVIDER",APCDIEN)) Q ;no provider key
.I APCDSTAT="I",$P($G(^VA(200,APCDIEN,"PS")),U,4)="" Q
.I APCDSTAT="A",$P($G(^VA(200,APCDIEN,"PS")),U,4)]"" Q
.I $D(APCDAFFM) S X=$P($G(^VA(200,APCDIEN,9999999)),U,1) Q:X="" I X]"",'$D(APCDAFFM(X)) Q ;not correct AFF
.I $D(APCDDISM) S X=$P($G(^VA(200,APCDIEN,"PS")),U,5) Q:X="" I X,'$D(APCDDISM(X)) Q ;not correct DIS
.I $D(APCDDIVM) D I 'G Q
..S G=0,X=0 F S X=$O(^VA(200,APCDIEN,2,"B",X)) Q:X'=+X!(G) I $D(APCDDIVM(X)) S G=1
.S X=$$SORT(APCDIEN,APCDSORT)
.I X="" S X="---"
.S ^XTMP("APCDPTAB",APCDJ,APCDH,"PTS",X,APCDIEN)=""
.Q
Q
DONE ;
I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of report. PRESS ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
K APCDTS,APCDS,APCDM,APCDET
K ^XTMP("APCDPTAB",APCDJ,APCDH),APCDJ,APCDH
Q
;
;
PRINT ;EP - called from xbdbque
S APCDQ=0,APCDPG=0
D HEADER
S APCDSV="" F S APCDSV=$O(^XTMP("APCDPTAB",APCDJ,APCDH,"PTS",APCDSV)) Q:APCDSV=""!(APCDQ) D
.I APCDSORT'="N" D
..I APCDSV="ZZZZZZZ" W !!,"UNKNOWN",! Q
..W !!,APCDSV,!
.S APCDIEN=0 F S APCDIEN=$O(^XTMP("APCDPTAB",APCDJ,APCDH,"PTS",APCDSV,APCDIEN)) Q:APCDIEN'=+APCDIEN D
..I $Y>(IOSL-3) D HEADER Q:APCDQ
..W !,$E($P(^VA(200,APCDIEN,0),U),1,25),?27,$E($$VAL^XBDIQ1(200,APCDIEN,9999999.01),1,8)
..W ?36,$E($$VAL^XBDIQ1(200,APCDIEN,53.5),1,17)
..W ?54,$$VAL^XBDIQ1(200,APCDIEN,9999999.039)
..S APCDX=0 S APCDX=$O(^VA(200,APCDIEN,2,APCDX)) I APCDX,$P($G(^AUTTLOC(APCDX,0)),U,7)]"" W ?61,$P($G(^AUTTLOC(APCDX,0)),U,7)
..W ?72,$$DATE($$VALI^XBDIQ1(200,APCDIEN,53.4))
..F S APCDX=$O(^VA(200,APCDIEN,2,APCDX)) Q:APCDX'=+APCDX I APCDX,$P($G(^AUTTLOC(APCDX,0)),U,7)]"" W !?61,$P($G(^AUTTLOC(APCDX,0)),U,7)
D DONE
Q
G:'APCDPG HEADER1
K DIR I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCDQ=1 Q
W:$D(IOF) @IOF S APCDPG=APCDPG+1
W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",APCDPG,!
W $$CTR($P(^DIC(4,DUZ(2),0),U),80),!
W !,$$CTR("PROVIDER LISTING",80)
S X="Status: "_APCDSTAN W !,$$CTR(X,80)
S X="Affiliations: "
I APCDAFFT="A" S X=X_"All Affiliations"
I APCDAFFT="S" D
.S Y="" F S Y=$O(APCDAFFM(Y)) Q:Y'=+Y S X=X_" "_Y
W !,$$CTR(X,80)
I APCDDIST="A" S X=X_"All Disciplines/Provider Classes"
I APCDDIST="S" D
.S Y="" F S Y=$O(APCDDISM(Y)) Q:Y'=+Y S X=X_" "_$P($G(^DIC(7,Y,9999999)),U)
W !,$$CTR(X,80)
W !!,"NAME",?27,"AFFL",?36,"PROV CLASS",?54,"ADC",?72,"INACTIVE"
W !,$TR($J("",80)," ","-")
Q
D(D) ;
Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_(1700+$E(D,1,3))
C(X,X2,X3) ;
D COMMA^%DTC
Q X
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
;----------
SORT(P,S) ;
NEW R
S R=""
D @(S_"SORT")
I R="" S R="ZZZZZZZ"
Q R
;
ASORT ;
S R=$$VAL^XBDIQ1(200,P,9999999.01)
Q
NSORT ;
S R=$$VAL^XBDIQ1(200,P,.01)
Q
DSORT ;
S R=$$VAL^XBDIQ1(200,P,53.5)
Q
SSORT ;
S R=$$VALI^XBDIQ1(200,P,53.4)
I R="" S R="ACTIVE" Q
S R="INACTIVE"
Q
DATE(D) ;
I D="" Q ""
Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E((1700+$E(D,1,3)),3,4)
INTROT ;
;; PROVIDER LISTING
;;
;;This option will produce a report of all entries in File 200.
;;You will be able to select which entries to print based on any of the
;;following criteria:
;; Providers Only or all entries (providers are defined as those holding
;; the PROVIDER key, general users will not hold this key)
;; Active/Inactive Status
;; Provider Affiliation
;; Provider Discipline (Class)
;; Division the person has access to (this is an attempt to determine which
;; facility the provider works at, there currently no field to designate
;; where the provider works.)
;;The report can be sorted by name, affiliation, discipline, active/inactive
;;status or division.
;;END
APCDPTAB ; IHS/CMI/LAB - Provider table print
+1 ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
+2 ;
+3 ;
+4 ;
EP ;EP - called from option interactive
+1 DO EOJ
+2 IF $DATA(IOF)
WRITE @IOF
+3 SET APCDTEXT="INTROT"
FOR APCDJ=1:1
SET APCDX=$TEXT(@APCDTEXT+APCDJ)
IF $PIECE(APCDX,";;",2)="END"
QUIT
SET APCDT=$PIECE(APCDX,";;",2)
WRITE !,APCDT
PROVKEY ;
+1 KILL APCDTRIM
SET APCDTRIT=""
+2 SET DIR(0)="S^A:All Users;P:Providers Only (defined by having the PROVIDER key)"
SET DIR("A")="List which set of entries"
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO EOJ
+4 SET APCDPKEY=Y
ACTIVE ;
+1 KILL APCDSTAT
+2 SET DIR(0)="S^A:Active Providers;I:Inactive Providers;B:Both Active and Inactive Providers"
SET DIR("A")="List which set of providers"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO PROVKEY
+4 SET APCDSTAT=Y
SET APCDSTAN=Y(0)
AFFL ;
+1 KILL APCDAFFM
SET APCDAFFT=""
+2 SET DIR(0)="S^O:One or a Set of Affiliations;A:Any/All Affiliations"
SET DIR("A")="Include Providers with which Affiliation"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO ACTIVE
+4 SET APCDAFFT=Y
+5 IF APCDAFFT="A"
WRITE !!,"Providers of all affiliations will be included in the report.",!
GOTO DISC
+6 SET X="AFFILIATION"
SET DIC="^AMQQ(5,"
SET DIC(0)="FM"
SET DIC("S")="I $P(^(0),U,14)"
DO ^DIC
KILL DIC,DA
IF Y=-1
WRITE "OOPS - QMAN NOT CURRENT - QUITTING"
SET APCDERR=1
DO EOJ
QUIT Q
+7 DO PEP^AMQQGTX0(+Y,"APCDAFFM(")
+8 IF '$DATA(APCDAFFM)
GOTO AFFL
+9 IF $DATA(APCDAFFM("*"))
KILL APCDAFFM
GOTO AFFL
DISC ;
+1 KILL APCDDISM
SET APCDDIST=""
+2 SET DIR(0)="S^O:One or a Set of Disciplines/Provider Classes;A:Any/All Disciplines/Provider Classes"
SET DIR("A")="Include Providers with which Provider Class"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO ACTIVE
+4 SET APCDDIST=Y
+5 IF APCDDIST="A"
WRITE !!,"Providers of all Disciplines will be included in the report.",!
GOTO DIVC
+6 SET X="DISCIPLINE"
SET DIC="^AMQQ(5,"
SET DIC(0)="FM"
SET DIC("S")="I $P(^(0),U,14)"
DO ^DIC
KILL DIC,DA
IF Y=-1
WRITE "OOPS - QMAN NOT CURRENT - QUITTING"
SET APCDERR=1
DO EOJ
QUIT Q
+7 DO PEP^AMQQGTX0(+Y,"APCDDISM(")
+8 IF '$DATA(APCDDISM)
GOTO DISC
+9 IF $DATA(APCDDISM("*"))
KILL APCDDISM
GOTO DISC
DIVC ;
+1 WRITE !!,"You can select just providers who have access to a particular"
+2 WRITE !,"division. Since there is no designation in file 200 to specify"
+3 WRITE !,"which facility a provider works knowing which Division they have"
+4 WRITE !,"access to may help determine where they work."
+5 WRITE !
+6 KILL APCDDIVM
SET APCDDIVT=""
+7 SET DIR(0)="S^O:One or a Set of Divisions/Locations;A:Any/All Divisions/Locations"
SET DIR("A")="Include Providers with access to which division"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
GOTO ACTIVE
+9 SET APCDDIVT=Y
+10 IF APCDDIVT="A"
WRITE !!,"All will be included in the report.",!
GOTO SORTR
+11 SET X="LOCATION OF ENCOUNTER"
SET DIC="^AMQQ(5,"
SET DIC(0)="FM"
SET DIC("S")="I $P(^(0),U,14)"
DO ^DIC
KILL DIC,DA
IF Y=-1
WRITE "OOPS - QMAN NOT CURRENT - QUITTING"
SET APCDERR=1
DO EOJ
QUIT Q
+12 DO PEP^AMQQGTX0(+Y,"APCDDIVM(")
+13 IF '$DATA(APCDDIVM)
GOTO DIVC
+14 IF $DATA(APCDDIVM("*"))
KILL APCDDIVM
GOTO DIVC
SORTR ;
+1 SET APCDSORT=""
+2 SET DIR(0)="S^N:Provider Name;A:Affiliation;D:Discipline/Class;S:Active/Inactive Status"
SET DIR("A")="Sort the list by"
SET DIR("B")="N"
+3 KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO DIVC
+5 SET APCDSORT=Y
ZIS ;
+1 SET XBRP="PRINT^APCDPTAB"
SET XBRC="PROC^APCDPTAB"
SET XBRX="EOJ^APCDPTAB"
SET XBNS="APCD"
+2 DO ^XBDBQUE
+3 QUIT
EOJ ;
+1 DO ^XBFMK
+2 KILL DIC,DIR
+3 DO EN^XBVK("APCD")
+4 QUIT
+5 ;
PROC ;
+1 SET APCDJ=$JOB
SET APCDH=$HOROLOG
+2 KILL ^XTMP("APCDPTAB",APCDJ,APCDH)
+3 SET ^XTMP("APCDPTAB",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"PCC PROVIDER REPORT"
+4 SET APCDIEN=0
FOR
SET APCDIEN=$ORDER(^VA(200,APCDIEN))
IF APCDIEN'=+APCDIEN
QUIT
Begin DoDot:1
+5 ;no provider key
IF APCDPKEY="P"
IF '$DATA(^XUSEC("PROVIDER",APCDIEN))
QUIT
+6 IF APCDSTAT="I"
IF $PIECE($GET(^VA(200,APCDIEN,"PS")),U,4)=""
QUIT
+7 IF APCDSTAT="A"
IF $PIECE($GET(^VA(200,APCDIEN,"PS")),U,4)]""
QUIT
+8 ;not correct AFF
IF $DATA(APCDAFFM)
SET X=$PIECE($GET(^VA(200,APCDIEN,9999999)),U,1)
IF X=""
QUIT
IF X]""
IF '$DATA(APCDAFFM(X))
QUIT
+9 ;not correct DIS
IF $DATA(APCDDISM)
SET X=$PIECE($GET(^VA(200,APCDIEN,"PS")),U,5)
IF X=""
QUIT
IF X
IF '$DATA(APCDDISM(X))
QUIT
+10 IF $DATA(APCDDIVM)
Begin DoDot:2
+11 SET G=0
SET X=0
FOR
SET X=$ORDER(^VA(200,APCDIEN,2,"B",X))
IF X'=+X!(G)
QUIT
IF $DATA(APCDDIVM(X))
SET G=1
End DoDot:2
IF 'G
QUIT
+12 SET X=$$SORT(APCDIEN,APCDSORT)
+13 IF X=""
SET X="---"
+14 SET ^XTMP("APCDPTAB",APCDJ,APCDH,"PTS",X,APCDIEN)=""
+15 QUIT
End DoDot:1
+16 QUIT
DONE ;
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
SET DIR(0)="EO"
SET DIR("A")="End of report. PRESS ENTER"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 KILL APCDTS,APCDS,APCDM,APCDET
+3 KILL ^XTMP("APCDPTAB",APCDJ,APCDH),APCDJ,APCDH
+4 QUIT
+5 ;
+6 ;
PRINT ;EP - called from xbdbque
+1 SET APCDQ=0
SET APCDPG=0
+2 DO HEADER
+3 SET APCDSV=""
FOR
SET APCDSV=$ORDER(^XTMP("APCDPTAB",APCDJ,APCDH,"PTS",APCDSV))
IF APCDSV=""!(APCDQ)
QUIT
Begin DoDot:1
+4 IF APCDSORT'="N"
Begin DoDot:2
+5 IF APCDSV="ZZZZZZZ"
WRITE !!,"UNKNOWN",!
QUIT
+6 WRITE !!,APCDSV,!
End DoDot:2
+7 SET APCDIEN=0
FOR
SET APCDIEN=$ORDER(^XTMP("APCDPTAB",APCDJ,APCDH,"PTS",APCDSV,APCDIEN))
IF APCDIEN'=+APCDIEN
QUIT
Begin DoDot:2
+8 IF $Y>(IOSL-3)
DO HEADER
IF APCDQ
QUIT
+9 WRITE !,$EXTRACT($PIECE(^VA(200,APCDIEN,0),U),1,25),?27,$EXTRACT($$VAL^XBDIQ1(200,APCDIEN,9999999.01),1,8)
+10 WRITE ?36,$EXTRACT($$VAL^XBDIQ1(200,APCDIEN,53.5),1,17)
+11 WRITE ?54,$$VAL^XBDIQ1(200,APCDIEN,9999999.039)
+12 SET APCDX=0
SET APCDX=$ORDER(^VA(200,APCDIEN,2,APCDX))
IF APCDX
IF $PIECE($GET(^AUTTLOC(APCDX,0)),U,7)]""
WRITE ?61,$PIECE($GET(^AUTTLOC(APCDX,0)),U,7)
+13 WRITE ?72,$$DATE($$VALI^XBDIQ1(200,APCDIEN,53.4))
+14 FOR
SET APCDX=$ORDER(^VA(200,APCDIEN,2,APCDX))
IF APCDX'=+APCDX
QUIT
IF APCDX
IF $PIECE($GET(^AUTTLOC(APCDX,0)),U,7)]""
WRITE !?61,$PIECE($GET(^AUTTLOC(APCDX,0)),U,7)
End DoDot:2
End DoDot:1
+15 DO DONE
+16 QUIT
+1 IF 'APCDPG
GOTO HEADER1
+2 KILL DIR
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCDQ=1
QUIT
+1 IF $DATA(IOF)
WRITE @IOF
SET APCDPG=APCDPG+1
+2 WRITE !?3,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",APCDPG,!
+3 WRITE $$CTR($PIECE(^DIC(4,DUZ(2),0),U),80),!
+4 WRITE !,$$CTR("PROVIDER LISTING",80)
+5 SET X="Status: "_APCDSTAN
WRITE !,$$CTR(X,80)
+6 SET X="Affiliations: "
+7 IF APCDAFFT="A"
SET X=X_"All Affiliations"
+8 IF APCDAFFT="S"
Begin DoDot:1
+9 SET Y=""
FOR
SET Y=$ORDER(APCDAFFM(Y))
IF Y'=+Y
QUIT
SET X=X_" "_Y
End DoDot:1
+10 WRITE !,$$CTR(X,80)
+11 IF APCDDIST="A"
SET X=X_"All Disciplines/Provider Classes"
+12 IF APCDDIST="S"
Begin DoDot:1
+13 SET Y=""
FOR
SET Y=$ORDER(APCDDISM(Y))
IF Y'=+Y
QUIT
SET X=X_" "_$PIECE($GET(^DIC(7,Y,9999999)),U)
End DoDot:1
+14 WRITE !,$$CTR(X,80)
+15 WRITE !!,"NAME",?27,"AFFL",?36,"PROV CLASS",?54,"ADC",?72,"INACTIVE"
+16 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
+17 QUIT
D(D) ;
+1 QUIT $EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_(1700+$EXTRACT(D,1,3))
C(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT X
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
+3 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
+2 ;----------
SORT(P,S) ;
+1 NEW R
+2 SET R=""
+3 DO @(S_"SORT")
+4 IF R=""
SET R="ZZZZZZZ"
+5 QUIT R
+6 ;
ASORT ;
+1 SET R=$$VAL^XBDIQ1(200,P,9999999.01)
+2 QUIT
NSORT ;
+1 SET R=$$VAL^XBDIQ1(200,P,.01)
+2 QUIT
DSORT ;
+1 SET R=$$VAL^XBDIQ1(200,P,53.5)
+2 QUIT
SSORT ;
+1 SET R=$$VALI^XBDIQ1(200,P,53.4)
+2 IF R=""
SET R="ACTIVE"
QUIT
+3 SET R="INACTIVE"
+4 QUIT
DATE(D) ;
+1 IF D=""
QUIT ""
+2 QUIT $EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_$EXTRACT((1700+$EXTRACT(D,1,3)),3,4)
INTROT ;
+1 ;; PROVIDER LISTING
+2 ;;
+3 ;;This option will produce a report of all entries in File 200.
+4 ;;You will be able to select which entries to print based on any of the
+5 ;;following criteria:
+6 ;; Providers Only or all entries (providers are defined as those holding
+7 ;; the PROVIDER key, general users will not hold this key)
+8 ;; Active/Inactive Status
+9 ;; Provider Affiliation
+10 ;; Provider Discipline (Class)
+11 ;; Division the person has access to (this is an attempt to determine which
+12 ;; facility the provider works at, there currently no field to designate
+13 ;; where the provider works.)
+14 ;;The report can be sorted by name, affiliation, discipline, active/inactive
+15 ;;status or division.
+16 ;;END
