ORPRPM ;DAN/SLC Performance Measure; ;9/4/08 08:17
;;3.0;ORDER ENTRY/RESULTS REPORTING;**107,114,119,196,190,225,243,296**;Dec 17, 1997;Build 19
;
;DBIA SECTION
;4195 - EN^PSOTPCUL
;3744 - $$TESTPAT^VADPT
;10060- Reference to file 200
;
;This routine will print a report indicating the percent of
;orders entered for a provider by a provider holding the ORES key.
;The data for the report will be stored in ^TMP as follows:
;^TMP($J,"SUM",Provider Name,Patient Status)=Total # of order (universe)^Denominator^Numerator^Verbal^Written^Telephone^Policy^Electronically entered^Student entered^Outpatient narcotic orders
;Where Patient Status is I for inpatient or O for outpatient.
;
N DIR,ORSD,ORED,ORPROV,ORTYPE,ORPT,ORREP,ORPIECE,Y,DIRUT,DUOUT,DTOUT,ZTRTN,ORDT,ORIEN,ORACT0,ORPVID,PG,REPDT,ORSTOP,ORI,ORJ,ORPAT,ORTOT,ORSTOT,X,ORPVNM,ORORD,ORPTST,ORP,ORWROTE,ORNS,ORFS,ORPFILE
D GETDATE K DIR Q:$D(DIRUT) ;quit if no dates selected ;get start and end dates
D GETPROV K DIR Q:'$D(ORPROV)!($G(ORPROV)'="ALL"&($D(ORPROV)'=11))!($D(DUOUT))!($D(DTOUT)) ;quit if user didn't select all providers or if didn't choose individual providers or if user timed out or up-arrowed out
D GETOTHER Q:$D(DIRUT) ;quit if any questions were unanswered in this section
S ZTRTN="DQ^ORPRPM" D QUE^ORUTL1(ZTRTN,"CPRS Performance Monitor")
Q
;
GETDATE ;Prompt for start and end dates
S DIR(0)="DO^:DT:AE",DIR("A")="Enter starting date",DIR("?")="Enter date to begin searching from" D ^DIR Q:$D(DIRUT) S ORSD=Y
S DIR(0)="DOA^"_ORSD_":DT:AE",DIR("A")="Enter ending date: ",DIR("?")="Enter date to stop searching. Must be between "_$$FMTE^XLFDT(ORSD,2)_" and "_$$FMTE^XLFDT(DT,2) D ^DIR Q:$D(DIRUT)
S ORED=Y_.24,ORSD=ORSD-.1 ;Set end date to end of day, start date back to include current day
Q ;End GETDATE
;
GETPROV ;Allow selection of all/single/multiple providers
;return ORPROV="ALL" for all providers or ORPROV array for individual providers
S DIR(0)="Y",DIR("A")="Do you want ALL providers to appear on this report",DIR("B")="Y",DIR("?")="Enter Yes to search for all providers. Enter No to select individual providers" D ^DIR Q:$D(DIRUT) S ORPROV=$S(Y=1:"ALL",1:"") Q:ORPROV="ALL"
K DIR ;clear DIR variables before getting individual providers
F D Q:$D(DIRUT) ;quit when finished selecting
.S DIR(0)="PO^200:AEQM",DIR("S")="I $D(^VA(200,""AK.PROVIDER"",$P(^(0),U)))",DIR("A")="Select "_$S($D(ORPROV)=11:"another ",1:"")_"provider"
.S DIR("?")="Select providers to appear on report. Return when finished, ^ to stop processing" D ^DIR Q:$D(DIRUT) S ORPROV(+Y)=""
Q ;End GETPROV
;
GETOTHER ;Get order type, patient type, and summary only report response
;Get order type first
S DIR(0)="S^A:All orders;P:Pharmacy orders only",DIR("A")="Select order category",DIR("B")="P",DIR("?")="Enter P to see pharmacy orders only. Enter A to see all orders. Enter ^ to quit" D ^DIR Q:$D(DIRUT) S ORTYPE=Y
K DIR
;Get patient status
S DIR(0)="S^I:Inpatient;O:Outpatient;B:Both",DIR("A")="Select patient status",DIR("B")="B",DIR("?")="Enter patient status at time of order. Enter ^ to quit" D ^DIR Q:$D(DIRUT) S ORPT=Y
K DIR
;Ask if user desires facility subtotal, summary, detail, or both (detail and summary) reports
S DIR(0)="S^S:Summary (includes provider details);D:Detail (includes order details);B:Both (Summary & Detail);T:Summary Report Totals Only (no provider details)",DIR("A")="Select report",DIR("B")="S"
D ^DIR Q:$D(DIRUT) S ORREP=Y,ORFS=0 I Y="T" S ORREP="S",ORFS=1
K DIR
Q ;End GETOTHER
;
DQ ;Come here to do build and print from QUE^ORUTL either direct or tasked
U IO K ^TMP($J) ;clean out temp space
S ORDT=ORSD F S ORDT=$O(^OR(100,"AF",ORDT)) Q:'ORDT!(ORDT>ORED) S ORIEN="" F S ORIEN=$O(^OR(100,"AF",ORDT,ORIEN)) Q:'ORIEN I $O(^OR(100,"AF",ORDT,ORIEN,0))=1 I $D(^OR(100,ORIEN,8,1,0)) D CHECK
D PRINT^ORPRPM1
K ^TMP($J)
Q
;
CHECK ;If order matches requirements then save
S ORPFILE=$P($G(^OR(100,ORIEN,0)),"^",2) Q:ORPFILE="" ;Quit if no object of order
I $P(ORPFILE,";",2)["DPT" Q:$$TESTPAT^VADPT(+$P($G(^OR(100,ORIEN,0)),"^",2)) ;225 Quit if test patient
Q:+$P($G(^OR(100,ORIEN,3)),"^",11)'=0 ;190 quit if order type not standard
Q:$P(^ORD(100.98,$P(^OR(100,ORIEN,0),U,11),0),U)="NON-VA MEDICATIONS" ;225 Quit if Non-VA med entry
S ORPTST=$P($G(^OR(100,ORIEN,0)),"^",12) ;patient status (in/out)
I ORPT'="B" Q:ORPTST'=ORPT ;Quit if patient status is not 'both' and status doesn't match selected status
S ORNS=$$NMSP^ORCD($P($G(^OR(100,ORIEN,0)),"^",14))
I ORTYPE'="A"&(ORNS'="PS") Q ;if not getting all types of orders then quit if order is not from pharmacy
I ORPTST="O",ORNS="PS",$G(^OR(100,ORIEN,4))=+$G(^OR(100,ORIEN,4)),$L($T(EN^PSOTPCUL)) Q:$$EN^PSOTPCUL($G(^OR(100,ORIEN,4))) ;196 Don't count if outpatient pharm order is a transitional pharmacy benefit order
S ORACT0=$G(^OR(100,ORIEN,8,1,0)),ORORD=$P(ORACT0,"^",12) ;ORORD holds nature of order ien
S ORPVID=$P(ORACT0,"^",3) I ORPROV'="ALL" Q:'$D(ORPROV(ORPVID)) ;quit if ordering provider doesn't match user selected provider
S ORPVNM=$$GET1^DIQ(200,ORPVID_",",.01) ;225 get provider name
Q:'$D(^XUSEC("ORES",ORPVID)) ;quit if ordering provider doesn't have ORES key DBIA # 10076 allows direct read of XUSEC
Q:"^1^2^3^5^8^"'[("^"_ORORD_"^") ;quit if NATURE OF ORDER is not verbal, written, telephoned, policy, or electronically entered
D COUNT ;Count order
Q
;
COUNT ;This section determines how the order should be counted
N OREB,ORPIECE
D ADD(1) ;Add one to universe (total # of orders)
S OREB=$P(ORACT0,"^",13) ;Entered by
S ^TMP($J,"DET",ORPVNM,ORIEN)=$D(^XUSEC("ORES",OREB))&(OREB=ORPVID) ;Mark "HAS ORES" column for detailed listing if entered by = provider and has ORES key
I OREB=ORPVID D ADD(2),ADD(3) Q ;if order entered by provider then add one to denominator and numerator
I ORNS="PS" I $$OIDEA=1 D ADD(10) Q ;If order requires wet signature add one to narcotic group
I $$STUDENT D ADD(9) Q ;If order entered by student add one to student group
S ORPIECE=$S(ORORD=1:4,ORORD=2:5,ORORD=3:6,ORORD=8:7,1:8) D ADD(ORPIECE) ;add to exceptions group for orders not entered by provider
I ORORD'=5 D ADD(2) ;Add to denominator if not policy order
Q
;
ADD(PIECE) ;Add one to storage
S $P(^TMP($J,"SUM",ORPVNM,ORPTST),"^",PIECE)=$P($G(^TMP($J,"SUM",ORPVNM,ORPTST)),"^",PIECE)+1 Q
;
OIDEA() ;Check to see if pharmacy order requires wet signature
;dbia 3373 allows call to pharmacy API or dbia 221 allows direct read of ^PSDRUG if routine doesn't exist yet
N OI,PSOI,SIGREQ,PSSXOLP,PSSXOLPD,PSSXOLPX,PSSXNODD,PSSPKLX
Q:ORPTST'="O" 0 ;quit if inpatient
S OI=$$VALUE^ORX8(ORIEN,"ORDERABLE") ;get orderable item
S PSOI=+$P($G(^ORD(101.43,+OI,0)),U,2) I PSOI'>0 Q 0 ;quit if no pharmacy orderable item
I $L($T(OIDEA^PSSUTLA1)) S SIGREQ=$$OIDEA^PSSUTLA1(PSOI,"O") Q:SIGREQ=1 1 Q 0 ;If SIGREQ = 1 then wet signature required
S (PSSXOLPD,PSSXNODD)=0
S PSSPKLX=0
K ^TMP($J,"ORPRPM ASP")
D ASP^PSS50(PSOI,,,"ORPRPM ASP")
F PSSXOLP=0:0 S PSSXOLP=$O(^TMP($J,"ORPRPM ASP","")) Q:'PSSXOLP!(PSSXOLPD=1) D
.K ^TMP($J,"ORPRPM DATA") D DATA^PSS50(PSSXOLP,,(DT-1),,,"ORPRPM DATA") I +^TMP($J,"ORPRPM DATA",0)<0 Q
.I 'PSSPKLX,$G(^TMP($J,"ORPRPM DATA",63))'["O" K ^TMP($J,"ORPRPM DATA") Q
.I PSSPKLX I $G(^TMP($J,"ORPRPM DATA",63))'["U",$G(^TMP($J,"ORPRPM DATA",63))'["I" Q
.S PSSXNODD=1
.S PSSXOLPX=$G(^TMP($J,"ORPRPM DATA",3))
.I PSSXOLPX[1!(PSSXOLPX[2)!((PSSXOLPX[3)&(PSSXOLPX["A")) S PSSXOLPD=1 Q
.I PSSXOLPX[3!(PSSXOLPX[4)!(PSSXOLPX[5) S PSSXOLPD=2
I PSSXOLPD=0,'PSSXNODD S PSSXOLPD=""
K ^TMP($J,"ORPRPM ASP")
K ^TMP($J,"ORPRPM DATA")
Q PSSXOLPD
;
STUDENT() ;Check to see if entered by is a student
;Check USER CLASS for membership in "STUDENT" CLASS - DBIA 2324
;Then check PROVIDER CLASS in NEW PERSON file for "STUDENT" - DBIA 10060
N ORCLASS,ORSUB,EXPIRE,ORUSR
D WHATIS^USRLM(OREB,"ORCLASS") ;API to get user class membership
S ORSUB=0,ORUSR=0 F S ORSUB=$O(ORCLASS(ORSUB)) Q:ORSUB=""!ORUSR D
.I $$UP^XLFSTR(ORSUB)'["STUDENT" Q ;User not a member of student class
.I ORDT'<+$P(ORCLASS(ORSUB),"^",4) S EXPIRE=$S(+$P(ORCLASS(ORSUB),"^",5):$P(ORCLASS(ORSUB),"^",5),1:9999999) I ORDT'>EXPIRE S ORUSR=1 ;member of student class and within date range for class
I ORUSR Q 1 ;User identified as a student
K ORCLASS
S DIC=200,DR=53.5,DA=OREB,DIQ="ORCLASS",DIQ(0)="E" D EN^DIQ1
I $G(ORCLASS(200,OREB,53.5,"E"))["STUDENT" Q 1 ;Provider class set to student
Q 0 ;User not a student
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORPRPM 8581 printed Apr 09, 2024@21:37:11 Page 2
ORPRPM ;DAN/SLC Performance Measure; ;9/4/08 08:17
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**107,114,119,196,190,225,243,296**;Dec 17, 1997;Build 19
+2 ;
+3 ;DBIA SECTION
+4 ;4195 - EN^PSOTPCUL
+5 ;3744 - $$TESTPAT^VADPT
+6 ;10060- Reference to file 200
+7 ;
+8 ;This routine will print a report indicating the percent of
+9 ;orders entered for a provider by a provider holding the ORES key.
+10 ;The data for the report will be stored in ^TMP as follows:
+11 ;^TMP($J,"SUM",Provider Name,Patient Status)=Total # of order (universe)^Denominator^Numerator^Verbal^Written^Telephone^Policy^Electronically entered^Student entered^Outpatient narcotic orders
+12 ;Where Patient Status is I for inpatient or O for outpatient.
+13 ;
+14 NEW DIR,ORSD,ORED,ORPROV,ORTYPE,ORPT,ORREP,ORPIECE,Y,DIRUT,DUOUT,DTOUT,ZTRTN,ORDT,ORIEN,ORACT0,ORPVID,PG,REPDT,ORSTOP,ORI,ORJ,ORPAT,ORTOT,ORSTOT,X,ORPVNM,ORORD,ORPTST,ORP,ORWROTE,ORNS,ORFS,ORPFILE
+15 ;quit if no dates selected ;get start and end dates
DO GETDATE
KILL DIR
if $DATA(DIRUT)
QUIT
+16 ;quit if user didn't select all providers or if didn't choose individual providers or if user timed out or up-arrowed out
DO GETPROV
KILL DIR
if '$DATA(ORPROV)!($GET(ORPROV)'="ALL"&($DATA(ORPROV)'=11))!($DATA(DUOUT))!($DATA(DTOUT))
QUIT
+17 ;quit if any questions were unanswered in this section
DO GETOTHER
if $DATA(DIRUT)
QUIT
+18 SET ZTRTN="DQ^ORPRPM"
DO QUE^ORUTL1(ZTRTN,"CPRS Performance Monitor")
+19 QUIT
+20 ;
GETDATE ;Prompt for start and end dates
+1 SET DIR(0)="DO^:DT:AE"
SET DIR("A")="Enter starting date"
SET DIR("?")="Enter date to begin searching from"
DO ^DIR
if $DATA(DIRUT)
QUIT
SET ORSD=Y
+2 SET DIR(0)="DOA^"_ORSD_":DT:AE"
SET DIR("A")="Enter ending date: "
SET DIR("?")="Enter date to stop searching. Must be between "_$$FMTE^XLFDT(ORSD,2)_" and "_$$FMTE^XLFDT(DT,2)
DO ^DIR
if $DATA(DIRUT)
QUIT
+3 ;Set end date to end of day, start date back to include current day
SET ORED=Y_.24
SET ORSD=ORSD-.1
+4 ;End GETDATE
QUIT
+5 ;
GETPROV ;Allow selection of all/single/multiple providers
+1 ;return ORPROV="ALL" for all providers or ORPROV array for individual providers
+2 SET DIR(0)="Y"
SET DIR("A")="Do you want ALL providers to appear on this report"
SET DIR("B")="Y"
SET DIR("?")="Enter Yes to search for all providers. Enter No to select individual providers"
DO ^DIR
if $DATA(DIRUT)
QUIT
SET ORPROV=$SELECT(Y=1:"ALL",1:"")
if ORPROV="ALL"
QUIT
+3 ;clear DIR variables before getting individual providers
KILL DIR
+4 ;quit when finished selecting
FOR
Begin DoDot:1
+5 SET DIR(0)="PO^200:AEQM"
SET DIR("S")="I $D(^VA(200,""AK.PROVIDER"",$P(^(0),U)))"
SET DIR("A")="Select "_$SELECT($DATA(ORPROV)=11:"another ",1:"")_"provider"
+6 SET DIR("?")="Select providers to appear on report. Return when finished, ^ to stop processing"
DO ^DIR
if $DATA(DIRUT)
QUIT
SET ORPROV(+Y)=""
End DoDot:1
if $DATA(DIRUT)
QUIT
+7 ;End GETPROV
QUIT
+8 ;
GETOTHER ;Get order type, patient type, and summary only report response
+1 ;Get order type first
+2 SET DIR(0)="S^A:All orders;P:Pharmacy orders only"
SET DIR("A")="Select order category"
SET DIR("B")="P"
SET DIR("?")="Enter P to see pharmacy orders only. Enter A to see all orders. Enter ^ to quit"
DO ^DIR
if $DATA(DIRUT)
QUIT
SET ORTYPE=Y
+3 KILL DIR
+4 ;Get patient status
+5 SET DIR(0)="S^I:Inpatient;O:Outpatient;B:Both"
SET DIR("A")="Select patient status"
SET DIR("B")="B"
SET DIR("?")="Enter patient status at time of order. Enter ^ to quit"
DO ^DIR
if $DATA(DIRUT)
QUIT
SET ORPT=Y
+6 KILL DIR
+7 ;Ask if user desires facility subtotal, summary, detail, or both (detail and summary) reports
+8 SET DIR(0)="S^S:Summary (includes provider details);D:Detail (includes order details);B:Both (Summary & Detail);T:Summary Report Totals Only (no provider details)"
SET DIR("A")="Select report"
SET DIR("B")="S"
+9 DO ^DIR
if $DATA(DIRUT)
QUIT
SET ORREP=Y
SET ORFS=0
IF Y="T"
SET ORREP="S"
SET ORFS=1
+10 KILL DIR
+11 ;End GETOTHER
QUIT
+12 ;
DQ ;Come here to do build and print from QUE^ORUTL either direct or tasked
+1 ;clean out temp space
USE IO
KILL ^TMP($JOB)
+2 SET ORDT=ORSD
FOR
SET ORDT=$ORDER(^OR(100,"AF",ORDT))
if 'ORDT!(ORDT>ORED)
QUIT
SET ORIEN=""
FOR
SET ORIEN=$ORDER(^OR(100,"AF",ORDT,ORIEN))
if 'ORIEN
QUIT
IF $ORDER(^OR(100,"AF",ORDT,ORIEN,0))=1
IF $DATA(^OR(100,ORIEN,8,1,0))
DO CHECK
+3 DO PRINT^ORPRPM1
+4 KILL ^TMP($JOB)
+5 QUIT
+6 ;
CHECK ;If order matches requirements then save
+1 ;Quit if no object of order
SET ORPFILE=$PIECE($GET(^OR(100,ORIEN,0)),"^",2)
if ORPFILE=""
QUIT
+2 ;225 Quit if test patient
IF $PIECE(ORPFILE,";",2)["DPT"
if $$TESTPAT^VADPT(+$PIECE($GET(^OR(100,ORIEN,0)),"^",2))
QUIT
+3 ;190 quit if order type not standard
if +$PIECE($GET(^OR(100,ORIEN,3)),"^",11)'=0
QUIT
+4 ;225 Quit if Non-VA med entry
if $PIECE(^ORD(100.98,$PIECE(^OR(100,ORIEN,0),U,11),0),U)="NON-VA MEDICATIONS"
QUIT
+5 ;patient status (in/out)
SET ORPTST=$PIECE($GET(^OR(100,ORIEN,0)),"^",12)
+6 ;Quit if patient status is not 'both' and status doesn't match selected status
IF ORPT'="B"
if ORPTST'=ORPT
QUIT
+7 SET ORNS=$$NMSP^ORCD($PIECE($GET(^OR(100,ORIEN,0)),"^",14))
+8 ;if not getting all types of orders then quit if order is not from pharmacy
IF ORTYPE'="A"&(ORNS'="PS")
QUIT
+9 ;196 Don't count if outpatient pharm order is a transitional pharmacy benefit order
IF ORPTST="O"
IF ORNS="PS"
IF $GET(^OR(100,ORIEN,4))=+$GET(^OR(100,ORIEN,4))
IF $LENGTH($TEXT(EN^PSOTPCUL))
if $$EN^PSOTPCUL($GET(^OR(100,ORIEN,4)))
QUIT
+10 ;ORORD holds nature of order ien
SET ORACT0=$GET(^OR(100,ORIEN,8,1,0))
SET ORORD=$PIECE(ORACT0,"^",12)
+11 ;quit if ordering provider doesn't match user selected provider
SET ORPVID=$PIECE(ORACT0,"^",3)
IF ORPROV'="ALL"
if '$DATA(ORPROV(ORPVID))
QUIT
+12 ;225 get provider name
SET ORPVNM=$$GET1^DIQ(200,ORPVID_",",.01)
+13 ;quit if ordering provider doesn't have ORES key DBIA # 10076 allows direct read of XUSEC
if '$DATA(^XUSEC("ORES",ORPVID))
QUIT
+14 ;quit if NATURE OF ORDER is not verbal, written, telephoned, policy, or electronically entered
if "^1^2^3^5^8^"'[("^"_ORORD_"^")
QUIT
+15 ;Count order
DO COUNT
+16 QUIT
+17 ;
COUNT ;This section determines how the order should be counted
+1 NEW OREB,ORPIECE
+2 ;Add one to universe (total # of orders)
DO ADD(1)
+3 ;Entered by
SET OREB=$PIECE(ORACT0,"^",13)
+4 ;Mark "HAS ORES" column for detailed listing if entered by = provider and has ORES key
SET ^TMP($JOB,"DET",ORPVNM,ORIEN)=$DATA(^XUSEC("ORES",OREB))&(OREB=ORPVID)
+5 ;if order entered by provider then add one to denominator and numerator
IF OREB=ORPVID
DO ADD(2)
DO ADD(3)
QUIT
+6 ;If order requires wet signature add one to narcotic group
IF ORNS="PS"
IF $$OIDEA=1
DO ADD(10)
QUIT
+7 ;If order entered by student add one to student group
IF $$STUDENT
DO ADD(9)
QUIT
+8 ;add to exceptions group for orders not entered by provider
SET ORPIECE=$SELECT(ORORD=1:4,ORORD=2:5,ORORD=3:6,ORORD=8:7,1:8)
DO ADD(ORPIECE)
+9 ;Add to denominator if not policy order
IF ORORD'=5
DO ADD(2)
+10 QUIT
+11 ;
ADD(PIECE) ;Add one to storage
+1 SET $PIECE(^TMP($JOB,"SUM",ORPVNM,ORPTST),"^",PIECE)=$PIECE($GET(^TMP($JOB,"SUM",ORPVNM,ORPTST)),"^",PIECE)+1
QUIT
+2 ;
OIDEA() ;Check to see if pharmacy order requires wet signature
+1 ;dbia 3373 allows call to pharmacy API or dbia 221 allows direct read of ^PSDRUG if routine doesn't exist yet
+2 NEW OI,PSOI,SIGREQ,PSSXOLP,PSSXOLPD,PSSXOLPX,PSSXNODD,PSSPKLX
+3 ;quit if inpatient
if ORPTST'="O"
QUIT 0
+4 ;get orderable item
SET OI=$$VALUE^ORX8(ORIEN,"ORDERABLE")
+5 ;quit if no pharmacy orderable item
SET PSOI=+$PIECE($GET(^ORD(101.43,+OI,0)),U,2)
IF PSOI'>0
QUIT 0
+6 ;If SIGREQ = 1 then wet signature required
IF $LENGTH($TEXT(OIDEA^PSSUTLA1))
SET SIGREQ=$$OIDEA^PSSUTLA1(PSOI,"O")
if SIGREQ=1
QUIT 1
QUIT 0
+7 SET (PSSXOLPD,PSSXNODD)=0
+8 SET PSSPKLX=0
+9 KILL ^TMP($JOB,"ORPRPM ASP")
+10 DO ASP^PSS50(PSOI,,,"ORPRPM ASP")
+11 FOR PSSXOLP=0:0
SET PSSXOLP=$ORDER(^TMP($JOB,"ORPRPM ASP",""))
if 'PSSXOLP!(PSSXOLPD=1)
QUIT
Begin DoDot:1
+12 KILL ^TMP($JOB,"ORPRPM DATA")
DO DATA^PSS50(PSSXOLP,,(DT-1),,,"ORPRPM DATA")
IF +^TMP($JOB,"ORPRPM DATA",0)<0
QUIT
+13 IF 'PSSPKLX
IF $GET(^TMP($JOB,"ORPRPM DATA",63))'["O"
KILL ^TMP($JOB,"ORPRPM DATA")
QUIT
+14 IF PSSPKLX
IF $GET(^TMP($JOB,"ORPRPM DATA",63))'["U"
IF $GET(^TMP($JOB,"ORPRPM DATA",63))'["I"
QUIT
+15 SET PSSXNODD=1
+16 SET PSSXOLPX=$GET(^TMP($JOB,"ORPRPM DATA",3))
+17 IF PSSXOLPX[1!(PSSXOLPX[2)!((PSSXOLPX[3)&(PSSXOLPX["A"))
SET PSSXOLPD=1
QUIT
+18 IF PSSXOLPX[3!(PSSXOLPX[4)!(PSSXOLPX[5)
SET PSSXOLPD=2
End DoDot:1
+19 IF PSSXOLPD=0
IF 'PSSXNODD
SET PSSXOLPD=""
+20 KILL ^TMP($JOB,"ORPRPM ASP")
+21 KILL ^TMP($JOB,"ORPRPM DATA")
+22 QUIT PSSXOLPD
+23 ;
STUDENT() ;Check to see if entered by is a student
+1 ;Check USER CLASS for membership in "STUDENT" CLASS - DBIA 2324
+2 ;Then check PROVIDER CLASS in NEW PERSON file for "STUDENT" - DBIA 10060
+3 NEW ORCLASS,ORSUB,EXPIRE,ORUSR
+4 ;API to get user class membership
DO WHATIS^USRLM(OREB,"ORCLASS")
+5 SET ORSUB=0
SET ORUSR=0
FOR
SET ORSUB=$ORDER(ORCLASS(ORSUB))
if ORSUB=""!ORUSR
QUIT
Begin DoDot:1
+6 ;User not a member of student class
IF $$UP^XLFSTR(ORSUB)'["STUDENT"
QUIT
+7 ;member of student class and within date range for class
IF ORDT'<+$PIECE(ORCLASS(ORSUB),"^",4)
SET EXPIRE=$SELECT(+$PIECE(ORCLASS(ORSUB),"^",5):$PIECE(ORCLASS(ORSUB),"^",5),1:9999999)
IF ORDT'>EXPIRE
SET ORUSR=1
End DoDot:1
+8 ;User identified as a student
IF ORUSR
QUIT 1
+9 KILL ORCLASS
+10 SET DIC=200
SET DR=53.5
SET DA=OREB
SET DIQ="ORCLASS"
SET DIQ(0)="E"
DO EN^DIQ1
+11 ;Provider class set to student
IF $GET(ORCLASS(200,OREB,53.5,"E"))["STUDENT"
QUIT 1
+12 ;User not a student
QUIT 0
