- 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
- 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
