Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORPRPM.m

    r613 r623  
    1 ORPRPM  ;DAN/SLC Performance Measure; ;4/8/04  10:20
    2         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**107,114,119,196,190,243**;Dec 17, 1997;Build 242
    3         ;
    4         ;DBIA SECTION
    5         ;4195 - EN^PSOTPCUL
    6         ;
    7         ;This routine will print a report indicating the percent of
    8         ;orders entered for a provider by a provider holding the ORES key.
    9         ;The data for the report will be stored in ^TMP as follows:
    10         ;^TMP($J,"SUM",Provider Name,Patient Status)=Total # of order (universe)^Denominator^Numerator^Verbal^Written^Telephone^Policy^Electronically entered^Student entered^Outpatient narcotic orders
    11         ;Where Patient Status is I for inpatient or O for outpatient.
    12         ;
    13         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
    14         D GETDATE K DIR Q:$D(DIRUT)  ;quit if no dates selected ;get start and end dates
    15         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
    16         D GETOTHER Q:$D(DIRUT)  ;quit if any questions were unanswered in this section
    17         I DUZ=1395 D DQ Q
    18         S ZTRTN="DQ^ORPRPM" D QUE^ORUTL1(ZTRTN,"CPRS Performance Monitor")
    19         Q
    20         ;
    21 GETDATE ;Prompt for start and end dates
    22         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
    23         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)
    24         S ORED=Y_.24,ORSD=ORSD-.1 ;Set end date to end of day, start date back to include current day
    25         Q  ;End GETDATE
    26         ;
    27 GETPROV ;Allow selection of all/single/multiple providers
    28         ;return ORPROV="ALL" for all providers or ORPROV array for individual providers
    29         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"
    30         K DIR ;clear DIR variables before getting individual providers
    31         F  D  Q:$D(DIRUT)  ;quit when finished selecting
    32         .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"
    33         .S DIR("?")="Select providers to appear on report.  Return when finished, ^ to stop processing" D ^DIR Q:$D(DIRUT)  S ORPROV(+Y)=""
    34         Q  ;End GETPROV
    35         ;
    36 GETOTHER        ;Get order type, patient type, and summary only report response
    37         ;Get order type first
    38         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
    39         K DIR
    40         ;Get patient status
    41         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
    42         K DIR
    43         ;Ask if user desires facility subtotal, summary, detail, or both (detail and summary) reports
    44         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"
    45         D ^DIR Q:$D(DIRUT)  S ORREP=Y,ORFS=0 I Y="T" S ORREP="S",ORFS=1
    46         K DIR
    47         Q  ;End GETOTHER
    48         ;
    49 DQ      ;Come here to do build and print from QUE^ORUTL either direct or tasked
    50         U IO K ^TMP($J) ;clean out temp space
    51         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
    52         D PRINT^ORPRPM1
    53         K ^TMP($J)
    54         Q
    55         ;
    56 CHECK   ;If order matches requirements then save
    57         S ORPFILE=$P($G(^OR(100,ORIEN,0)),"^",2) Q:ORPFILE=""  ;Quit if no object of order
    58         I $P(ORPFILE,";",2)["DPT" Q:$P($G(^DPT(+$P($G(^OR(100,ORIEN,0)),"^",2),0)),"^",21)  ;Quit if test patient
    59         Q:+$P($G(^OR(100,ORIEN,3)),"^",11)'=0  ;190 quit if order type not standard
    60         S ORPTST=$P($G(^OR(100,ORIEN,0)),"^",12) ;patient status (in/out)
    61         I ORPT'="B" Q:ORPTST'=ORPT  ;Quit if patient status is not 'both' and status doesn't match selected status
    62         S ORNS=$$NMSP^ORCD($P($G(^OR(100,ORIEN,0)),"^",14))
    63         I ORTYPE'="A"&(ORNS'="PS") Q  ;if not getting all types of orders then quit if order is not from pharmacy
    64         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
    65         S ORACT0=$G(^OR(100,ORIEN,8,1,0)),ORORD=$P(ORACT0,"^",12) ;ORORD holds nature of order ien
    66         S ORPVID=$P(ORACT0,"^",3) I ORPROV'="ALL" Q:'$D(ORPROV(ORPVID))  ;quit if ordering provider doesn't match user selected provider
    67         S ORPVNM=$P($G(^VA(200,ORPVID,0)),"^") ;get provider name
    68         Q:'$D(^XUSEC("ORES",ORPVID))  ;quit if ordering provider doesn't have ORES key DBIA # 10076 allows direct read of XUSEC
    69         Q:"^1^2^3^5^8^"'[("^"_ORORD_"^")  ;quit if NATURE OF ORDER is not verbal, written, telephoned, policy, or electronically entered
    70         D COUNT ;Count order
    71         Q
    72         ;
    73 COUNT   ;This section determines how the order should be counted
    74         N OREB,ORPIECE
    75         D ADD(1) ;Add one to universe (total # of orders)
    76         S OREB=$P(ORACT0,"^",13) ;Entered by
    77         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
    78         I OREB=ORPVID D ADD(2),ADD(3) Q  ;if order entered by provider then add one to denominator and numerator
    79         I ORNS="PS" I $$OIDEA=1 D ADD(10) Q  ;If order requires wet signature add one to narcotic group
    80         I $$STUDENT D ADD(9) Q  ;If order entered by student add one to student group
    81         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
    82         I ORORD'=5 D ADD(2) ;Add to denominator if not policy order
    83         Q
    84         ;
    85 ADD(PIECE)      ;Add one to storage
    86         S $P(^TMP($J,"SUM",ORPVNM,ORPTST),"^",PIECE)=$P($G(^TMP($J,"SUM",ORPVNM,ORPTST)),"^",PIECE)+1 Q
    87         ;
    88 OIDEA() ;Check to see if pharmacy order requires wet signature
    89         ;dbia 3373 allows call to pharmacy API or dbia 221 allows direct read of ^PSDRUG if routine doesn't exist yet
    90         N OI,PSOI,SIGREQ,PSSXOLP,PSSXOLPD,PSSXOLPX,PSSXNODD,PSSPKLX
    91         Q:ORPTST'="O" 0 ;quit if inpatient
    92         S OI=$$VALUE^ORX8(ORIEN,"ORDERABLE") ;get orderable item
    93         S PSOI=+$P($G(^ORD(101.43,+OI,0)),U,2) I PSOI'>0 Q 0 ;quit if no pharmacy orderable item
    94         I $L($T(OIDEA^PSSUTLA1)) S SIGREQ=$$OIDEA^PSSUTLA1(PSOI,"O") Q:SIGREQ=1 1 Q 0 ;If SIGREQ = 1 then wet signature required
    95         S (PSSXOLPD,PSSXNODD)=0
    96         S PSSPKLX=0
    97         K ^TMP($J,"ORPRPM ASP")
    98         D ASP^PSS50(PSOI,,,"ORPRPM ASP")
    99         F PSSXOLP=0:0 S PSSXOLP=$O(^TMP($J,"ORPRPM ASP","")) Q:'PSSXOLP!(PSSXOLPD=1)  D
    100         .K ^TMP($J,"ORPRPM DATA") D DATA^PSS50(PSSXOLP,,(DT-1),,,"ORPRPM DATA") I +^TMP($J,"ORPRPM DATA",0)<0 Q
    101         .I 'PSSPKLX,$G(^TMP($J,"ORPRPM DATA",63))'["O" K ^TMP($J,"ORPRPM DATA") Q
    102         .I PSSPKLX I $G(^TMP($J,"ORPRPM DATA",63))'["U",$G(^TMP($J,"ORPRPM DATA",63))'["I" Q
    103         .S PSSXNODD=1
    104         .S PSSXOLPX=$G(^TMP($J,"ORPRPM DATA",3))
    105         .I PSSXOLPX[1!(PSSXOLPX[2)!((PSSXOLPX[3)&(PSSXOLPX["A")) S PSSXOLPD=1 Q
    106         .I PSSXOLPX[3!(PSSXOLPX[4)!(PSSXOLPX[5) S PSSXOLPD=2
    107         I PSSXOLPD=0,'PSSXNODD S PSSXOLPD=""
    108         K ^TMP($J,"ORPRPM ASP")
    109         K ^TMP($J,"ORPRPM DATA")
    110         Q PSSXOLPD
    111         ;
    112 STUDENT()       ;Check to see if entered by is a student
    113         ;Check USER CLASS for membership in "STUDENT" CLASS - DBIA 2324
    114         ;Then check PROVIDER CLASS in NEW PERSON file for "STUDENT" - DBIA 10060
    115         N ORCLASS,ORSUB,EXPIRE,ORUSR
    116         D WHATIS^USRLM(OREB,"ORCLASS") ;API to get user class membership
    117         S ORSUB=0,ORUSR=0 F  S ORSUB=$O(ORCLASS(ORSUB)) Q:ORSUB=""!ORUSR  D
    118         .I $$UP^XLFSTR(ORSUB)'["STUDENT" Q  ;User not a member of student class
    119         .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
    120         I ORUSR Q 1 ;User identified as a student
    121         K ORCLASS
    122         S DIC=200,DR=53.5,DA=OREB,DIQ="ORCLASS",DIQ(0)="E" D EN^DIQ1
    123         I $G(ORCLASS(200,OREB,53.5,"E"))["STUDENT" Q 1 ;Provider class set to student
    124         Q 0 ;User not a student
     1ORPRPM ;DAN/SLC Performance Measure; ;10/7/04  09:08
     2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**107,114,119,196,190,225**;Dec 17, 1997
     3 ;
     4 ;DBIA SECTION
     5 ;4195 - EN^PSOTPCUL
     6 ;3744 - $$TESTPAT^VADPT
     7 ;10060- Reference to file 200
     8 ;
     9 ;This routine will print a report indicating the percent of
     10 ;orders entered for a provider by a provider holding the ORES key.
     11 ;The data for the report will be stored in ^TMP as follows:
     12 ;^TMP($J,"SUM",Provider Name,Patient Status)=Total # of order (universe)^Denominator^Numerator^Verbal^Written^Telephone^Policy^Electronically entered^Student entered^Outpatient narcotic orders
     13 ;Where Patient Status is I for inpatient or O for outpatient.
     14 ;
     15 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
     16 D GETDATE K DIR Q:$D(DIRUT)  ;quit if no dates selected ;get start and end dates
     17 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
     18 D GETOTHER Q:$D(DIRUT)  ;quit if any questions were unanswered in this section
     19 S ZTRTN="DQ^ORPRPM" D QUE^ORUTL1(ZTRTN,"CPRS Performance Monitor")
     20 Q
     21 ;
     22GETDATE ;Prompt for start and end dates
     23 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
     24 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)
     25 S ORED=Y_.24,ORSD=ORSD-.1 ;Set end date to end of day, start date back to include current day
     26 Q  ;End GETDATE
     27 ;
     28GETPROV ;Allow selection of all/single/multiple providers
     29 ;return ORPROV="ALL" for all providers or ORPROV array for individual providers
     30 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"
     31 K DIR ;clear DIR variables before getting individual providers
     32 F  D  Q:$D(DIRUT)  ;quit when finished selecting
     33 .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"
     34 .S DIR("?")="Select providers to appear on report.  Return when finished, ^ to stop processing" D ^DIR Q:$D(DIRUT)  S ORPROV(+Y)=""
     35 Q  ;End GETPROV
     36 ;
     37GETOTHER ;Get order type, patient type, and summary only report response
     38 ;Get order type first
     39 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
     40 K DIR
     41 ;Get patient status
     42 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
     43 K DIR
     44 ;Ask if user desires facility subtotal, summary, detail, or both (detail and summary) reports
     45 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"
     46 D ^DIR Q:$D(DIRUT)  S ORREP=Y,ORFS=0 I Y="T" S ORREP="S",ORFS=1
     47 K DIR
     48 Q  ;End GETOTHER
     49 ;
     50DQ ;Come here to do build and print from QUE^ORUTL either direct or tasked
     51 U IO K ^TMP($J) ;clean out temp space
     52 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
     53 D PRINT^ORPRPM1
     54 K ^TMP($J)
     55 Q
     56 ;
     57CHECK ;If order matches requirements then save
     58 S ORPFILE=$P($G(^OR(100,ORIEN,0)),"^",2) Q:ORPFILE=""  ;Quit if no object of order
     59 I $P(ORPFILE,";",2)["DPT" Q:$$TESTPAT^VADPT(+$P($G(^OR(100,ORIEN,0)),"^",2))  ;225 Quit if test patient
     60 Q:+$P($G(^OR(100,ORIEN,3)),"^",11)'=0  ;190 quit if order type not standard
     61 Q:$P(^ORD(100.98,$P(^OR(100,ORIEN,0),U,11),0),U)="NON-VA MEDICATIONS"  ;225 Quit if Non-VA med entry
     62 S ORPTST=$P($G(^OR(100,ORIEN,0)),"^",12) ;patient status (in/out)
     63 I ORPT'="B" Q:ORPTST'=ORPT  ;Quit if patient status is not 'both' and status doesn't match selected status
     64 S ORNS=$$NMSP^ORCD($P($G(^OR(100,ORIEN,0)),"^",14))
     65 I ORTYPE'="A"&(ORNS'="PS") Q  ;if not getting all types of orders then quit if order is not from pharmacy
     66 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
     67 S ORACT0=$G(^OR(100,ORIEN,8,1,0)),ORORD=$P(ORACT0,"^",12) ;ORORD holds nature of order ien
     68 S ORPVID=$P(ORACT0,"^",3) I ORPROV'="ALL" Q:'$D(ORPROV(ORPVID))  ;quit if ordering provider doesn't match user selected provider
     69 S ORPVNM=$$GET1^DIQ(200,ORPVID_",",.01) ;225 get provider name
     70 Q:'$D(^XUSEC("ORES",ORPVID))  ;quit if ordering provider doesn't have ORES key DBIA # 10076 allows direct read of XUSEC
     71 Q:"^1^2^3^5^8^"'[("^"_ORORD_"^")  ;quit if NATURE OF ORDER is not verbal, written, telephoned, policy, or electronically entered
     72 D COUNT ;Count order
     73 Q
     74 ;
     75COUNT ;This section determines how the order should be counted
     76 N OREB,ORPIECE
     77 D ADD(1) ;Add one to universe (total # of orders)
     78 S OREB=$P(ORACT0,"^",13) ;Entered by
     79 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
     80 I OREB=ORPVID D ADD(2),ADD(3) Q  ;if order entered by provider then add one to denominator and numerator
     81 I ORNS="PS" I $$OIDEA=1 D ADD(10) Q  ;If order requires wet signature add one to narcotic group
     82 I $$STUDENT D ADD(9) Q  ;If order entered by student add one to student group
     83 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
     84 I ORORD'=5 D ADD(2) ;Add to denominator if not policy order
     85 Q
     86 ;
     87ADD(PIECE) ;Add one to storage
     88 S $P(^TMP($J,"SUM",ORPVNM,ORPTST),"^",PIECE)=$P($G(^TMP($J,"SUM",ORPVNM,ORPTST)),"^",PIECE)+1 Q
     89 ;
     90OIDEA() ;Check to see if pharmacy order requires wet signature
     91 ;dbia 3373 allows call to pharmacy API or dbia 221 allows direct read of ^PSDRUG if routine doesn't exist yet
     92 N OI,PSOI,SIGREQ,PSSXOLP,PSSXOLPD,PSSXOLPX,PSSXNODD,PSSPKLX
     93 Q:ORPTST'="O" 0 ;quit if inpatient
     94 S OI=$$VALUE^ORX8(ORIEN,"ORDERABLE") ;get orderable item
     95 S PSOI=+$P($G(^ORD(101.43,+OI,0)),U,2) I PSOI'>0 Q 0 ;quit if no pharmacy orderable item
     96 I $L($T(OIDEA^PSSUTLA1)) S SIGREQ=$$OIDEA^PSSUTLA1(PSOI,"O") Q:SIGREQ=1 1 Q 0 ;If SIGREQ = 1 then wet signature required
     97 S (PSSXOLPD,PSSXNODD)=0
     98 S PSSPKLX=0
     99 F PSSXOLP=0:0 S PSSXOLP=$O(^PSDRUG("ASP",PSOI,PSSXOLP)) Q:'PSSXOLP!(PSSXOLPD=1)  D
     100 .I $P($G(^PSDRUG(PSSXOLP,"I")),"^"),$P($G(^("I")),"^")<DT Q
     101 .I 'PSSPKLX,$P($G(^PSDRUG(PSSXOLP,2)),"^",3)'["O" Q
     102 .I PSSPKLX I $P($G(^PSDRUG(PSSXOLP,2)),"^",3)'["U",$P($G(^(2)),"^",3)'["I" Q
     103 .S PSSXNODD=1
     104 .S PSSXOLPX=$P($G(^PSDRUG(PSSXOLP,0)),"^",3)
     105 .I PSSXOLPX[1!(PSSXOLPX[2)!((PSSXOLPX[3)&(PSSXOLPX["A")) S PSSXOLPD=1 Q
     106 .I PSSXOLPX[3!(PSSXOLPX[4)!(PSSXOLPX[5) S PSSXOLPD=2
     107 I PSSXOLPD=0,'PSSXNODD S PSSXOLPD=""
     108 Q PSSXOLPD
     109 ;
     110STUDENT() ;Check to see if entered by is a student
     111 ;Check USER CLASS for membership in "STUDENT" CLASS - DBIA 2324
     112 ;Then check PROVIDER CLASS in NEW PERSON file for "STUDENT" - DBIA 10060
     113 N ORCLASS,ORSUB,EXPIRE,ORUSR
     114 D WHATIS^USRLM(OREB,"ORCLASS") ;API to get user class membership
     115 S ORSUB=0,ORUSR=0 F  S ORSUB=$O(ORCLASS(ORSUB)) Q:ORSUB=""!ORUSR  D
     116 .I $$UP^XLFSTR(ORSUB)'["STUDENT" Q  ;User not a member of student class
     117 .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
     118 I ORUSR Q 1 ;User identified as a student
     119 K ORCLASS
     120 S DIC=200,DR=53.5,DA=OREB,DIQ="ORCLASS",DIQ(0)="E" D EN^DIQ1
     121 I $G(ORCLASS(200,OREB,53.5,"E"))["STUDENT" Q 1 ;Provider class set to student
     122 Q 0 ;User not a student
Note: See TracChangeset for help on using the changeset viewer.