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/ORWRP1.m

    r613 r623  
    1 ORWRP1  ; ALB/MJK,dcm Report Calls ;7/20/07  14:43
    2         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,160,262,269**;Dec 17, 1997;Build 29
    3         ;
    4 AHS(ROOT,ORDFN,ORHS,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE)    ; - get adhoc health summary report
    5         D START^ORWRP(80,"AHSB^ORWRP1(.ROOT,.ORDFN,.ORHS,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
    6         Q
    7 AHSB(ROOT,ORDFN,ORHS,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE)   ; -build adhoc health summary
    8         N ORVP,GMTYP,Y
    9         S ORVP=ORDFN_";DPT(",Y=$P($G(^GMT(142,+ORHS,0)),U),GMTSTYP=+ORHS
    10         D ADHOC^ORPRS13
    11         Q
    12 HS(ROOT,ORDFN,ORHS,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE)     ; - get health summary report
    13         D START^ORWRP(80,"HSB^ORWRP1(.ROOT,.ORDFN,.ORHS,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
    14         Q
    15 HSB(ROOT,ORDFN,ORHS,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE)    ; - build health summary report
    16         N I,ICN,ORVP,GMTYP,Y,GMARXN,GMTSDLM,GMTSDTC,GMTSE,GMTSEGH,GMTSEGL,GMTSEGN,GMTSEGR,GMSEQ,GMTSHDR,GMTSLCMP,GMTSNDM,GMTSNPK,GMTSPG,GMTSPHDR,X
    17         I $G(REMOTE) D  Q:'ORHS
    18         . S Y=$O(^GMT(142,"E",$P(ORHS,";",2),0))
    19         . I 'Y S Y=$O(^GMT(142,"E",$P($$UPPER^ORU(ORHS),";",2),0))
    20         . I 'Y S I=0 F  S I=$O(^GMT(142,I)) Q:'I  I $L($P($G(^GMT(142,I,"T")),"^")),$P($$UPPER^ORU(ORHS),";",2)=$$UPPER^ORU(^("T")) S Y=I Q
    21         . I 'Y S Y=$O(^GMT(142,"B",$P(ORHS,";",2),0))
    22         . I 'Y S Y=$O(^GMT(142,"B",$P($$UPPER^ORU(ORHS),";",2),0))
    23         . I 'Y S I=0 F  S I=$O(^GMT(142,I)) Q:'I  S X=$P(^(I,0),"^") I $P($$UPPER^ORU(ORHS),";",2)=$$UPPER^ORU(X) S Y=I Q
    24         . I 'Y U IO W !,ORHS_" not found on remote system",! S ORHS=Y Q
    25         . S ORHS=Y
    26         I +$G(ORHS)<1 W !,"Report not Available" Q
    27         S ORVP=ORDFN_";DPT(",Y=$P($G(^GMT(142,+ORHS,0)),U),GMTYP(0)=1,GMTYP(1)=+ORHS_U_Y_U_Y_U_Y
    28         D PQ^ORPRS13
    29         Q
    30 HSTYPE(ROOT,ORDFN,ORHS,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; - Get HS type report
    31         D START^ORWRP(80,"HSTYPEB^ORWRP1(.ROOT,.ORDFN,.ORHS,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
    32         Q
    33 HSTYPEB(ROOT,ORDFN,ORHS,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE)        ; - Build HS type report
    34         N GMTSQIT,GMTSPRM,GMTSTITL,GMTSPX2,GMTSPX1
    35         I $L($G(DTRANGE)),'$G(ALPHA) S ALPHA=$$FMADD^XLFDT(DT,-DTRANGE),OMEGA=$$NOW^XLFDT
    36         Q:'$G(ALPHA)  Q:'$G(OMEGA)
    37         I +$G(ORHS)<1 W !,"Report not Available" Q
    38         S GMTSQIT=1,GMTSPRM=$P($G(^GMT(142.1,+ORHS,0)),"^",4),GMTSTITL="",GMTSPX2=ALPHA,GMTSPX1=OMEGA,DFN=ORDFN
    39         D ENCWA^GMTS
    40         Q
    41 HSGUI(DFN,GMTSTYP)      ; - Call ENX^GMTSDVR to print HS Type for Patient
    42         D ENX^GMTSDVR(DFN,GMTSTYP)
    43         Q
    44 BLR(ROOT,ORDFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE)      ; -- get 'enhanced' blood bank report
    45         N DFN,ORY,ORSBHEAD
    46         S DFN=ORDFN
    47         I $L($T(EN^ORWLR1)),$L($T(CPRS^VBECA3B)) D  Q  ;Transition to VBEC's interface
    48         . K ^TMP("ORLRC",$J)
    49         . D EN^ORWLR1(DFN)
    50         . I '$O(^TMP("ORLRC",$J,0)) S ^TMP("ORLRC",$J,1,0)="",^TMP("ORLRC",$J,2,0)="No Blood Bank report available..."
    51         . S ROOT=$NA(^TMP("ORLRC",$J))
    52         K ^TMP("LRC",$J)
    53         S ORSBHEAD("BLOOD BANK")=""
    54         D EN^LR7OSUM(.ORY,DFN,,,,,.ORSBHEAD)
    55         I '$O(^TMP("LRC",$J,0)) S ^TMP("LRC",$J,1,0)="",^TMP("LRC",$J,2,0)="No Blood Bank report available..."
    56         S ROOT=$NA(^TMP("LRC",$J))
    57         Q
    58 AP(ROOT,ORDFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE)       ; -- get Anatomic path report
    59         N I,C,LINES,X
    60         K ^TMP("LRC",$J),^TMP("LRH",$J)
    61         D AP^LR7OSUM(ORDFN)
    62         I '$O(^TMP("LRC",$J,0)) S ^TMP("LRC",$J,1,0)="",^TMP("LRC",$J,2,0)="No Anatomic Pathology reports available..."
    63         S I=0
    64         I $L($O(^TMP("LRH",$J,0))) S I=.001,^TMP("LRC",$J,I)="[HIDDEN TEXT]^" D
    65         . S X="",C=2 F  S X=$O(^TMP("LRH",$J,X)) Q:X=""  S LINES(^(X))=X,C=C+1
    66         . S $P(^TMP("LRC",$J,.001),"^",2)=C
    67         . S X="" F  S X=$O(LINES(X)) Q:X=""  D
    68         .. S I=I+.001,^TMP("LRC",$J,I)=X_"^"_LINES(X)
    69         . S I=I+.001,^TMP("LRC",$J,I)="[REPORT TEXT]"
    70         S ROOT=$NA(^TMP("LRC",$J))
    71         K ^TMP("LRH",$J)
    72         Q
    73 DIET(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE)       ; -- get dietetics profile
    74         N LCNT,ORVP
    75         S LCNT=0,ORVP=DFN_";DPT("
    76         D FHP^ORCXPNDR
    77         S ROOT=$NA(^TMP("ORXPND",$J))
    78         Q
    79 LISTNUTR(ROOT,DFN)      ; -- list nutritional assessments
    80         N OK,I,X
    81         K ^TMP($J,"FHADT")
    82         S OK=$$FHWORADT^FHWORA(DFN)
    83         S I=0,SITE=$$SITE^VASITE,SITE=$P(SITE,"^",2)_";"_$P(SITE,"^",3)
    84         F  S I=$O(^TMP($J,"FHADT",DFN,I)) Q:'I  S X=SITE_U_I_U_^(I),^(I)=X
    85         S ROOT=$NA(^TMP($J,"FHADT",DFN))
    86         Q
    87 NUTR(ROOT,DFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE)       ; -- get nutritional assessment
    88         N LCNT,ORVP
    89         K ^TMP("ORXPND",$J)
    90         S LCNT=0,ORVP=DFN_";DPT(",ID=DFN_";"_ID
    91         D FHA^ORCXPNDR
    92         S ROOT=$NA(^TMP("ORXPND",$J))
    93         Q
    94 VITALS(ROOT,ORDFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE)   ; -- get vitals report
    95         D START^ORWRP(132,"VITALSB^ORWRP1(.ROOT,.ORDFN,.ID,.ALPHA,.OMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)")
    96         D EN^GMRVPGC(ORDFN) Q
    97 VITALSB(ROOT,ORDFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE)  ; -- build vitals report
    98         N ORVP,XQORNOD,ORSSTRT,ORSSTOP
    99         Q:'$G(ORDFN)
    100         I $L(ORDTRNG),'$G(ALPHA) S ALPHA=$$FMADD^XLFDT(DT,-ORDTRNG),OMEGA=$$NOW^XLFDT
    101         Q:'$G(ALPHA)  Q:'$G(OMEGA)
    102         I '$P(OMEGA,".",2) S OMEGA=OMEGA_".2359"
    103         S ORVP=ORDFN_";DPT(",XQORNOD=1,ORSSTRT(XQORNOD)=ALPHA,ORSSTOP(XQORNOD)=OMEGA
    104         D VITCUM^ORPRS14
    105         Q
    106 STAT(ROOT,ORDFN,ID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Lab Order Status
    107         N ORVP
    108         K ^TMP("ORDATA",$J)
    109         S ORVP=ORDFN_";DPT("
    110         D EN1^LR7OSOS1(.ORY,ORVP,.ORALPHA,.OROMEGA,.ORDTRNG)
    111         I '$O(^TMP("ORDATA",$J,1,0)) S ^TMP("ORDATA",$J,1,1,0)="",^TMP("ORDATA",$J,1,2,0)="No Orders found..."
    112         S ROOT=ORY
    113         Q
    114 INTERIM(ROOT,ORDFN,ID,ORALPHA,OROMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE)      ;Lab Interim
    115         D START^ORWRP(80,"INTERIMB^ORWRP1(.ROOT,.ORDFN,.ID,.ORALPHA,.OROMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
    116         Q
    117 INTERIMB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE)   ;Build Interim
    118         Q:'$G(DFN)  Q:'$G(ALPHA)  Q:'$G(OMEGA)
    119         N ORVP,XQORNOD,ORSSTRT,ORSSTOP,LRACC,LRAD,LRAN,LRRT,LRPG,LRSB,LREDT,LRIDT
    120         S ORVP=DFN_";DPT(",XQORNOD=1,(ORSSTRT(XQORNOD),LREDT)=(9999999-ALPHA),(ORSSTOP(XQORNOD),LRIDT)=(9999999-OMEGA)
    121         D OERR^LRRP4,CLEAN^LRRP4
    122         Q
    123 LRGEN(ROOT,ORDFN,ID,ORALPHA,OROMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE)        ;Lab results by test
    124         D START^ORWRP(80,"LRGENB^ORWRP1(.ROOT,.ORDFN,.ID,.ORALPHA,.OROMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
    125         Q
    126 LRGENB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE)     ;Build Results
    127         Q:'$G(DFN)  Q:'$G(ALPHA)  Q:'$G(OMEGA)
    128         N ORVP,ORSSTRT,ORSSTOP,LREDT,LRSDT,XQORNOD
    129         S ORVP=DFN_";DPT(",XQORNOD=1,(ORSSTRT(XQORNOD),LREDT)=(9999999-ALPHA),(ORSSTOP(XQORNOD),LRSDT)=(9999999-OMEGA)
    130         D SET1^LRGEN,CLEAN^LRRP4
    131         K LRPR
    132         Q
    133 GRAPH(ROOT,ORDFN,ID,ORALPHA,OROMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE)        ;Graph labs
    134         D START^ORWRP(80,"GRAPHB^ORWRP1(.ROOT,.ORDFN,.ID,.ORALPHA,.OROMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
    135         Q
    136 GRAPHB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE)     ;Graph labs
    137         Q:'$G(DFN)  Q:'$G(ALPHA)  Q:'$G(OMEGA)
    138         N ORVP,XQORNOD,ORSSTRT,ORSSTOP,LREDT,LRSDT
    139         S ORVP=DFN_";DPT(",XQORNOD=1,(ORSSTRT(XQORNOD),LREDT)=ALPHA,(ORSSTOP(XQORNOD),LRSDT)=OMEGA
    140         D OERR^LRDIST4,CLEAN^LRDIST4
    141         Q
    142 ORS(ROOT,ORDFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE)      ;Daily order summary
    143         D START^ORWRP(80,"ORSB^ORWRP1(.ROOT,.ORDFN,.ID,.ALPHA,.OMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)")
    144         Q
    145 ORSB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE)       ;Daily order summary
    146         N ORVP,XQORNOD,ORSSTRT,ORSSTOP
    147         S ORVP=DFN_";DPT(",XQORNOD=1,X1=DT,X2=-$S(DTRANGE:DTRANGE-1,1:0)
    148         D C^%DTC
    149         S ORSSTRT=X-.7641,ORSSTOP=DT+.2359
    150         D DAY^ORPRS02
    151         Q
    152 ORD(ROOT,ORDFN,ID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE)  ;Order Summary for Date Range
    153         D START^ORWRP(80,"ORDB^ORWRP1(.ROOT,.ORDFN,.ID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)")
    154         Q
    155 ORDB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE)       ;Order Summary for Date Range
    156         Q:'$G(DFN)
    157         I $L($G(DTRANGE)),'$G(ALPHA) S ALPHA=$$FMADD^XLFDT(DT,-DTRANGE),OMEGA=$$NOW^XLFDT
    158         Q:'$G(ALPHA)  Q:'$G(OMEGA)
    159         N ORVP,XQORNOD,ORSSTRT,ORSSTOP
    160         S ORVP=DFN_";DPT(",XQORNOD=1,ORSSTRT=ALPHA,ORSSTOP=OMEGA
    161         D RANGE^ORPRS02
    162         Q
    163 ORC(ROOT,ORDFN,ID,ORALPHA,OROMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE)  ;Custom order summary
    164         D START^ORWRP(80,"ORCB^ORWRP1(.ROOT,.ORDFN,.ID,.ORALPHA,.OROMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
    165         Q
    166 ORCB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE)       ;Custom order summary build
    167         Q:'$G(DFN)  Q:'$G(ALPHA)  Q:'$G(OMEGA)
    168         N ORVP,XQORNOD,ORSSTRT,ORSSTOP
    169         S ORVP=DFN_";DPT(",XQORNOD=1,ORSSTRT=ALPHA,ORSSTOP=OMEGA
    170         D CUSTOM^ORPRS02
    171         Q
    172 ORP(ROOT,ORDFN,ID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE)  ;Chart copy summary
    173         D START^ORWRP(80,"ORPB^ORWRP1(.ROOT,.ORDFN,.ID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORFHIE)")
    174         Q
    175 ORPB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE)       ;Chart copy summary
    176         Q:'$G(DFN)
    177         I $L($G(DTRANGE)),'$G(ALPHA) S ALPHA=$$FMADD^XLFDT(DT,-DTRANGE),OMEGA=$$NOW^XLFDT
    178         Q:'$G(ALPHA)  Q:'$G(OMEGA)
    179         N ORVP,XQORNOD,ORSSTRT,ORSSTOP
    180         S ORVP=DFN_";DPT(",XQORNOD=1,ORSSTRT=ALPHA,ORSSTOP=OMEGA
    181         D CHART^ORPRS02
    182         Q
    183 PSO(ROOT,ORDFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE)      ;Outpatient RX Profile
    184         D START^ORWRP(80,"PSOB^ORWRP1(.ROOT,.ORDFN,.ID,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORFHIE)")
    185         Q
    186 PSOB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE)       ;Outpatient RX Action Profile
    187         N ORVP,PSTYPE,PSONOPG
    188         S ORVP=DFN_";DPT(",PSTYPE=1,PSONOPG=2
    189         D DFN^PSOSD1
    190         Q
    191 MED(ROOT,ORDFN,IID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE)     ;Medicine Summary of Procedures
    192         D START^ORWRP(80,"MEDB^ORWRP1(.ROOT,.ORDFN,.IID,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
    193         Q
    194 MEDB(ROOT,DFN,IID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE)      ;Medicine Summary of Procedures
    195         Q:'$L($G(IID))
    196         N ORVP,XQY0,OT,MCARPPS,MCPRO,MCARGRTN,DXS,SSN,I,J,L,DA,MCARGDA
    197         S ORVP=DFN_";DPT(",XQY0="",OT=$G(^TMP("OR",$J,"MCAR","OT",IID))
    198         Q:'$L(OT)
    199         S (DA,MCARGDA)=$P(OT,U,2),MCARPPS=$P(OT,U,3,4),MCPRO=$P(OT,U,11)
    200         D MCPPROC^MCARP
    201         S MCARGRTN=$P(OT,U,5)
    202         D @MCARPPS
    203         Q
    204 PROB(ROOT,ORDFN,IID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE)    ; Problem List (Problem Tab)
    205         D START^ORWRP(80,"PROBB^ORWRP1(.ROOT,.ORDFN,.IID,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
    206         Q
    207 PROBB(ROOT,DFN,IID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE)     ;Problem List
    208         N ORSILENT S ORSILENT=1
    209         D VAF^GMPLUTL2(DFN,ORSILENT)
    210         Q
     1ORWRP1 ; ALB/MJK,dcm Report Calls ;7/20/07  14:43
     2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,160,262,269**;Dec 17, 1997;Build 28
     3 ;
     4AHS(ROOT,ORDFN,ORHS,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; - get adhoc health summary report
     5 D START^ORWRP(80,"AHSB^ORWRP1(.ROOT,.ORDFN,.ORHS,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
     6 Q
     7AHSB(ROOT,ORDFN,ORHS,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; -build adhoc health summary
     8 N ORVP,GMTYP,Y
     9 S ORVP=ORDFN_";DPT(",Y=$P($G(^GMT(142,+ORHS,0)),U),GMTSTYP=+ORHS
     10 D ADHOC^ORPRS13
     11 Q
     12HS(ROOT,ORDFN,ORHS,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; - get health summary report
     13 D START^ORWRP(80,"HSB^ORWRP1(.ROOT,.ORDFN,.ORHS,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
     14 Q
     15HSB(ROOT,ORDFN,ORHS,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; - build health summary report
     16 N I,ICN,ORVP,GMTYP,Y,GMARXN,GMTSDLM,GMTSDTC,GMTSE,GMTSEGH,GMTSEGL,GMTSEGN,GMTSEGR,GMSEQ,GMTSHDR,GMTSLCMP,GMTSNDM,GMTSNPK,GMTSPG,GMTSPHDR,X
     17 I $G(REMOTE) D  Q:'ORHS
     18 . S Y=$O(^GMT(142,"E",$P(ORHS,";",2),0))
     19 . I 'Y S Y=$O(^GMT(142,"E",$P($$UPPER^ORU(ORHS),";",2),0))
     20 . I 'Y S I=0 F  S I=$O(^GMT(142,I)) Q:'I  I $L($P($G(^GMT(142,I,"T")),"^")),$P($$UPPER^ORU(ORHS),";",2)=$$UPPER^ORU(^("T")) S Y=I Q
     21 . I 'Y S Y=$O(^GMT(142,"B",$P(ORHS,";",2),0))
     22 . I 'Y S Y=$O(^GMT(142,"B",$P($$UPPER^ORU(ORHS),";",2),0))
     23 . I 'Y S I=0 F  S I=$O(^GMT(142,I)) Q:'I  S X=$P(^(I,0),"^") I $P($$UPPER^ORU(ORHS),";",2)=$$UPPER^ORU(X) S Y=I Q
     24 . I 'Y U IO W !,ORHS_" not found on remote system",! S ORHS=Y Q
     25 . S ORHS=Y
     26 I +$G(ORHS)<1 W !,"Report not Available" Q
     27 S ORVP=ORDFN_";DPT(",Y=$P($G(^GMT(142,+ORHS,0)),U),GMTYP(0)=1,GMTYP(1)=+ORHS_U_Y_U_Y_U_Y
     28 D PQ^ORPRS13
     29 Q
     30HSTYPE(ROOT,ORDFN,ORHS,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; - Get HS type report
     31 D START^ORWRP(80,"HSTYPEB^ORWRP1(.ROOT,.ORDFN,.ORHS,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
     32 Q
     33HSTYPEB(ROOT,ORDFN,ORHS,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; - Build HS type report
     34 N GMTSQIT,GMTSPRM,GMTSTITL,GMTSPX2,GMTSPX1
     35 I $L($G(DTRANGE)),'$G(ALPHA) S ALPHA=$$FMADD^XLFDT(DT,-DTRANGE),OMEGA=$$NOW^XLFDT
     36 Q:'$G(ALPHA)  Q:'$G(OMEGA)
     37 I +$G(ORHS)<1 W !,"Report not Available" Q
     38 S GMTSQIT=1,GMTSPRM=$P($G(^GMT(142.1,+ORHS,0)),"^",4),GMTSTITL="",GMTSPX2=ALPHA,GMTSPX1=OMEGA,DFN=ORDFN
     39 D ENCWA^GMTS
     40 Q
     41HSGUI(DFN,GMTSTYP) ; - Call ENX^GMTSDVR to print HS Type for Patient
     42 D ENX^GMTSDVR(DFN,GMTSTYP)
     43 Q
     44BLR(ROOT,ORDFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; -- get 'enhanced' blood bank report
     45 N DFN,ORY,ORSBHEAD
     46 S DFN=ORDFN
     47 I $L($T(EN^ORWLR1)),$L($T(CPRS^VBECA3B)) D  Q  ;Transition to VBEC's interface
     48 . K ^TMP("ORLRC",$J)
     49 . D EN^ORWLR1(DFN)
     50 . I '$O(^TMP("ORLRC",$J,0)) S ^TMP("ORLRC",$J,1,0)="",^TMP("ORLRC",$J,2,0)="No Blood Bank report available..."
     51 . S ROOT=$NA(^TMP("ORLRC",$J))
     52 K ^TMP("LRC",$J)
     53 S ORSBHEAD("BLOOD BANK")=""
     54 D EN^LR7OSUM(.ORY,DFN,,,,,.ORSBHEAD)
     55 I '$O(^TMP("LRC",$J,0)) S ^TMP("LRC",$J,1,0)="",^TMP("LRC",$J,2,0)="No Blood Bank report available..."
     56 S ROOT=$NA(^TMP("LRC",$J))
     57 Q
     58AP(ROOT,ORDFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; -- get Anatomic path report
     59 N I,C,LINES,X
     60 K ^TMP("LRC",$J),^TMP("LRH",$J)
     61 D AP^LR7OSUM(ORDFN)
     62 I '$O(^TMP("LRC",$J,0)) S ^TMP("LRC",$J,1,0)="",^TMP("LRC",$J,2,0)="No Anatomic Pathology reports available..."
     63 S I=0
     64 I $L($O(^TMP("LRH",$J,0))) S I=.001,^TMP("LRC",$J,I)="[HIDDEN TEXT]^" D
     65 . S X="",C=2 F  S X=$O(^TMP("LRH",$J,X)) Q:X=""  S LINES(^(X))=X,C=C+1
     66 . S $P(^TMP("LRC",$J,.001),"^",2)=C
     67 . S X="" F  S X=$O(LINES(X)) Q:X=""  D
     68 .. S I=I+.001,^TMP("LRC",$J,I)=X_"^"_LINES(X)
     69 . S I=I+.001,^TMP("LRC",$J,I)="[REPORT TEXT]"
     70 S ROOT=$NA(^TMP("LRC",$J))
     71 K ^TMP("LRH",$J)
     72 Q
     73DIET(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; -- get dietetics profile
     74 N LCNT,ORVP
     75 S LCNT=0,ORVP=DFN_";DPT("
     76 D FHP^ORCXPNDR
     77 S ROOT=$NA(^TMP("ORXPND",$J))
     78 Q
     79LISTNUTR(ROOT,DFN) ; -- list nutritional assessments
     80 N OK,I,X
     81 K ^TMP($J,"FHADT")
     82 S OK=$$FHWORADT^FHWORA(DFN)
     83 S I=0,SITE=$$SITE^VASITE,SITE=$P(SITE,"^",2)_";"_$P(SITE,"^",3)
     84 F  S I=$O(^TMP($J,"FHADT",DFN,I)) Q:'I  S X=SITE_U_I_U_^(I),^(I)=X
     85 S ROOT=$NA(^TMP($J,"FHADT",DFN))
     86 Q
     87NUTR(ROOT,DFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ; -- get nutritional assessment
     88 N LCNT,ORVP
     89 K ^TMP("ORXPND",$J)
     90 S LCNT=0,ORVP=DFN_";DPT(",ID=DFN_";"_ID
     91 D FHA^ORCXPNDR
     92 S ROOT=$NA(^TMP("ORXPND",$J))
     93 Q
     94VITALS(ROOT,ORDFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ; -- get vitals report
     95 D START^ORWRP(132,"VITALSB^ORWRP1(.ROOT,.ORDFN,.ID,.ALPHA,.OMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)")
     96 D EN^GMRVPGC(ORDFN) Q
     97VITALSB(ROOT,ORDFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ; -- build vitals report
     98 N ORVP,XQORNOD,ORSSTRT,ORSSTOP
     99 Q:'$G(ORDFN)
     100 I $L(ORDTRNG),'$G(ALPHA) S ALPHA=$$FMADD^XLFDT(DT,-ORDTRNG),OMEGA=$$NOW^XLFDT
     101 Q:'$G(ALPHA)  Q:'$G(OMEGA)
     102 I '$P(OMEGA,".",2) S OMEGA=OMEGA_".2359"
     103 S ORVP=ORDFN_";DPT(",XQORNOD=1,ORSSTRT(XQORNOD)=ALPHA,ORSSTOP(XQORNOD)=OMEGA
     104 D VITCUM^ORPRS14
     105 Q
     106STAT(ROOT,ORDFN,ID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Lab Order Status
     107 N ORVP
     108 K ^TMP("ORDATA",$J)
     109 S ORVP=ORDFN_";DPT("
     110 D EN1^LR7OSOS1(.ORY,ORVP,.ORALPHA,.OROMEGA,.ORDTRNG)
     111 I '$O(^TMP("ORDATA",$J,1,0)) S ^TMP("ORDATA",$J,1,1,0)="",^TMP("ORDATA",$J,1,2,0)="No Orders found..."
     112 S ROOT=ORY
     113 Q
     114INTERIM(ROOT,ORDFN,ID,ORALPHA,OROMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Lab Interim
     115 D START^ORWRP(80,"INTERIMB^ORWRP1(.ROOT,.ORDFN,.ID,.ORALPHA,.OROMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
     116 Q
     117INTERIMB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Build Interim
     118 Q:'$G(DFN)  Q:'$G(ALPHA)  Q:'$G(OMEGA)
     119 N ORVP,XQORNOD,ORSSTRT,ORSSTOP,LRACC,LRAD,LRAN,LRRT,LRPG,LRSB,LREDT,LRIDT
     120 S ORVP=DFN_";DPT(",XQORNOD=1,(ORSSTRT(XQORNOD),LREDT)=(9999999-ALPHA),(ORSSTOP(XQORNOD),LRIDT)=(9999999-OMEGA)
     121 D OERR^LRRP4,CLEAN^LRRP4
     122 Q
     123LRGEN(ROOT,ORDFN,ID,ORALPHA,OROMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Lab results by test
     124 D START^ORWRP(80,"LRGENB^ORWRP1(.ROOT,.ORDFN,.ID,.ORALPHA,.OROMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
     125 Q
     126LRGENB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Build Results
     127 Q:'$G(DFN)  Q:'$G(ALPHA)  Q:'$G(OMEGA)
     128 N ORVP,ORSSTRT,ORSSTOP,LREDT,LRSDT,XQORNOD
     129 S ORVP=DFN_";DPT(",XQORNOD=1,(ORSSTRT(XQORNOD),LREDT)=(9999999-ALPHA),(ORSSTOP(XQORNOD),LRSDT)=(9999999-OMEGA)
     130 D SET1^LRGEN,CLEAN^LRRP4
     131 K LRPR
     132 Q
     133GRAPH(ROOT,ORDFN,ID,ORALPHA,OROMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Graph labs
     134 D START^ORWRP(80,"GRAPHB^ORWRP1(.ROOT,.ORDFN,.ID,.ORALPHA,.OROMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
     135 Q
     136GRAPHB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Graph labs
     137 Q:'$G(DFN)  Q:'$G(ALPHA)  Q:'$G(OMEGA)
     138 N ORVP,XQORNOD,ORSSTRT,ORSSTOP,LREDT,LRSDT
     139 S ORVP=DFN_";DPT(",XQORNOD=1,(ORSSTRT(XQORNOD),LREDT)=ALPHA,(ORSSTOP(XQORNOD),LRSDT)=OMEGA
     140 D OERR^LRDIST4,CLEAN^LRDIST4
     141 Q
     142ORS(ROOT,ORDFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Daily order summary
     143 D START^ORWRP(80,"ORSB^ORWRP1(.ROOT,.ORDFN,.ID,.ALPHA,.OMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)")
     144 Q
     145ORSB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Daily order summary
     146 N ORVP,XQORNOD,ORSSTRT,ORSSTOP
     147 S ORVP=DFN_";DPT(",XQORNOD=1,X1=DT,X2=-$S(DTRANGE:DTRANGE-1,1:0)
     148 D C^%DTC
     149 S ORSSTRT=X-.7641,ORSSTOP=DT+.2359
     150 D DAY^ORPRS02
     151 Q
     152ORD(ROOT,ORDFN,ID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Order Summary for Date Range
     153 D START^ORWRP(80,"ORDB^ORWRP1(.ROOT,.ORDFN,.ID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)")
     154 Q
     155ORDB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Order Summary for Date Range
     156 Q:'$G(DFN)
     157 I $L($G(DTRANGE)),'$G(ALPHA) S ALPHA=$$FMADD^XLFDT(DT,-DTRANGE),OMEGA=$$NOW^XLFDT
     158 Q:'$G(ALPHA)  Q:'$G(OMEGA)
     159 N ORVP,XQORNOD,ORSSTRT,ORSSTOP
     160 S ORVP=DFN_";DPT(",XQORNOD=1,ORSSTRT=ALPHA,ORSSTOP=OMEGA
     161 D RANGE^ORPRS02
     162 Q
     163ORC(ROOT,ORDFN,ID,ORALPHA,OROMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Custom order summary
     164 D START^ORWRP(80,"ORCB^ORWRP1(.ROOT,.ORDFN,.ID,.ORALPHA,.OROMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
     165 Q
     166ORCB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Custom order summary build
     167 Q:'$G(DFN)  Q:'$G(ALPHA)  Q:'$G(OMEGA)
     168 N ORVP,XQORNOD,ORSSTRT,ORSSTOP
     169 S ORVP=DFN_";DPT(",XQORNOD=1,ORSSTRT=ALPHA,ORSSTOP=OMEGA
     170 D CUSTOM^ORPRS02
     171 Q
     172ORP(ROOT,ORDFN,ID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Chart copy summary
     173 D START^ORWRP(80,"ORPB^ORWRP1(.ROOT,.ORDFN,.ID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORFHIE)")
     174 Q
     175ORPB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Chart copy summary
     176 Q:'$G(DFN)
     177 I $L($G(DTRANGE)),'$G(ALPHA) S ALPHA=$$FMADD^XLFDT(DT,-DTRANGE),OMEGA=$$NOW^XLFDT
     178 Q:'$G(ALPHA)  Q:'$G(OMEGA)
     179 N ORVP,XQORNOD,ORSSTRT,ORSSTOP
     180 S ORVP=DFN_";DPT(",XQORNOD=1,ORSSTRT=ALPHA,ORSSTOP=OMEGA
     181 D CHART^ORPRS02
     182 Q
     183PSO(ROOT,ORDFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Outpatient RX Profile
     184 D START^ORWRP(80,"PSOB^ORWRP1(.ROOT,.ORDFN,.ID,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORFHIE)")
     185 Q
     186PSOB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Outpatient RX Action Profile
     187 N ORVP,PSTYPE,PSONOPG
     188 S ORVP=DFN_";DPT(",PSTYPE=1,PSONOPG=2
     189 D DFN^PSOSD1
     190 Q
     191MED(ROOT,ORDFN,IID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Medicine Summary of Procedures
     192 D START^ORWRP(80,"MEDB^ORWRP1(.ROOT,.ORDFN,.IID,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
     193 Q
     194MEDB(ROOT,DFN,IID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Medicine Summary of Procedures
     195 Q:'$L($G(IID))
     196 N ORVP,XQY0,OT,MCARPPS,MCPRO,MCARGRTN,DXS,SSN,I,J,L,DA,MCARGDA
     197 S ORVP=DFN_";DPT(",XQY0="",OT=$G(^TMP("OR",$J,"MCAR","OT",IID))
     198 Q:'$L(OT)
     199 S (DA,MCARGDA)=$P(OT,U,2),MCARPPS=$P(OT,U,3,4),MCPRO=$P(OT,U,11)
     200 D MCPPROC^MCARP
     201 S MCARGRTN=$P(OT,U,5)
     202 D @MCARPPS
     203 Q
     204PROB(ROOT,ORDFN,IID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; Problem List (Problem Tab)
     205 D START^ORWRP(80,"PROBB^ORWRP1(.ROOT,.ORDFN,.IID,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
     206 Q
     207PROBB(ROOT,DFN,IID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Problem List
     208 N ORSILENT S ORSILENT=1
     209 D VAF^GMPLUTL2(DFN,ORSILENT)
     210 Q
Note: See TracChangeset for help on using the changeset viewer.