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

    r613 r623  
    1 ORWTIU  ; slc/REV - Functions for GUI PARAMETER ACTIONS ; 08 Feb 2001  09:02AM
    2         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,132,195,243**;Dec 17, 1997;Build 242
    3         ;
    4 GTTIUCTX(Y,ORUSER)      ; Returns current Notes view context for user
    5         N OCCLIM,SHOWSUB
    6         S Y=$$GET^XPAR("ALL","ORCH CONTEXT NOTES",1)
    7         I +$P(Y,";",5)=0 D
    8         . S OCCLIM=$P($$PERSPRF^TIULE(DUZ),U,10)
    9         . S:+OCCLIM>0 $P(Y,";",5)=OCCLIM
    10         S SHOWSUB=$P(Y,";",6)
    11         S $P(Y,";",6)=$S(SHOWSUB'="":SHOWSUB,1:0)
    12         Q
    13 SVTIUCTX(Y,ORCTXT)      ; Save new Notes view preferences for user
    14         N TMP
    15         S TMP=$$GET^XPAR(DUZ_";VA(200,","ORCH CONTEXT NOTES",1)
    16         I TMP'="" D  Q
    17         . D CHG^XPAR(DUZ_";VA(200,","ORCH CONTEXT NOTES",1,ORCTXT)
    18         D ADD^XPAR(DUZ_";VA(200,","ORCH CONTEXT NOTES",1,ORCTXT)
    19         Q
    20         ;
    21 GTDCCTX(Y,ORUSER)       ; Returns current DC Summary view context for user
    22         N OCCLIM,SHOWSUB
    23         S Y=$$GET^XPAR("ALL","ORCH CONTEXT SUMMRIES",1)
    24         I +$P(Y,";",5)=0 D
    25         . S OCCLIM=$P($$PERSPRF^TIULE(DUZ),U,10)
    26         . S:+OCCLIM>0 $P(Y,";",5)=OCCLIM
    27         S SHOWSUB=$P(Y,";",6)
    28         S $P(Y,";",6)=$S(SHOWSUB'="":SHOWSUB,1:0)
    29         Q
    30 SVDCCTX(Y,ORCTXT)       ; Save new DC Summary view preferences for user
    31         N TMP
    32         S TMP=$$GET^XPAR(DUZ_";VA(200,","ORCH CONTEXT SUMMRIES",1)
    33         I TMP'="" D  Q
    34         . D CHG^XPAR(DUZ_";VA(200,","ORCH CONTEXT SUMMRIES",1,ORCTXT)
    35         D ADD^XPAR(DUZ_";VA(200,","ORCH CONTEXT SUMMRIES",1,ORCTXT)
    36         Q
    37         ;
    38 PRINTW(ORY,ORDA,ORFLG)  ;TIU print to windows printer
    39         N ZTQUEUED,ORHFS,ORSUB,ORIO,ORSTATUS,ROOT,ORERR,ORWIN,ORHANDLE
    40         N IOM,IOSL,IOST,IOF,IOT,IOS
    41         S (ORSUB,ROOT)="ORDATA",ORIO="OR WINDOWS HFS",ORWIN=1,ORHANDLE="ORWTIU"
    42         S ORY=$NA(^TMP(ORSUB,$J,1))
    43         S ORHFS=$$HFS^ORWRP()
    44         D HFSOPEN^ORWRP(ORHANDLE,ORHFS,"W")
    45         I POP D  Q
    46         . I $D(ROOT) D SETITEM^ORWRP(.ROOT,"ERROR: Unable to open HFS file for TIU print")
    47         D IOVAR^ORWRP(.ORIO,,,"P-WINHFS80")
    48         N $ETRAP,$ESTACK
    49         S $ETRAP="D ERR^ORWRP Q"
    50         U IO
    51         D RPC^TIUPD(.ORERR,ORDA,ORIO,ORFLG,ORWIN)
    52         D HFSCLOSE^ORWRP(ORHANDLE,ORHFS)
    53         Q
    54 GTLSTITM(ORY,ORTIUDA)   ; Return single listbox item for document
    55         Q:+$G(ORTIUDA)=0
    56         S ORY=ORTIUDA_U_$$RESOLVE^TIUSRVLO(ORTIUDA)
    57         Q
    58 IDNOTES(ORY)       ; Is ID Notes installed?
    59         S ORY=$$PATCH^XPDUTL("TIU*1.0*100")
    60         Q
    61 CANLINK(ORY,ORTITLE)       ;Can the title be an ID child?
    62         ; DBIA #2322
    63         S ORY=$$CANLINK^TIULP(ORTITLE)
    64         Q
    65 GETCP(ORY,ORTIUDA)      ; Checks required CP fields before signature
    66         S ORY=""
    67         N ORTITLE,ORAUTH,ORCOS,ORPSUMCD,ORPROCDT,ORROOT,ORERR,ORREFDT
    68         S ORERR="",ORROOT=$NA(^TMP("ORTIU",$J))
    69         D EXTRACT^TIULQ(ORTIUDA,.ORROOT,.ORERR,".01;1202;1208;70201;70202;1301",,,"I")
    70         S ORTITLE=@ORROOT@(ORTIUDA,".01","I")
    71         S ORAUTH=@ORROOT@(ORTIUDA,"1202","I")
    72         S ORCOS=@ORROOT@(ORTIUDA,"1208","I")
    73         S ORPSUMCD=@ORROOT@(ORTIUDA,"70201","I")
    74         S ORPROCDT=@ORROOT@(ORTIUDA,"70202","I")
    75         S ORREFDT=@ORROOT@(ORTIUDA,"1301","I")
    76         S ORY=ORAUTH_U_ORCOS_U_ORPSUMCD_U_ORPROCDT_U_ORTITLE_U_ORREFDT
    77         K @ORROOT
    78         Q
    79 CHKTXT(ORY,ORTIUDA)     ; Checks for presence of text before signature
    80         S ORY='$$EMPTYDOC^TIULF(ORTIUDA)  ;DBIA #4426
    81         Q
     1ORWTIU ; slc/REV - Functions for GUI PARAMETER ACTIONS ; 08 Feb 2001  09:02AM
     2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,132,195**;Dec 17, 1997
     3 ;
     4GTTIUCTX(Y,ORUSER) ; Returns current Notes view context for user
     5 N OCCLIM,SHOWSUB
     6 S Y=$$GET^XPAR("ALL","ORCH CONTEXT NOTES",1)
     7 I +$P(Y,";",5)=0 D
     8 . S OCCLIM=$P($$PERSPRF^TIULE(DUZ),U,10)
     9 . S:+OCCLIM>0 $P(Y,";",5)=OCCLIM
     10 S SHOWSUB=$P(Y,";",6)
     11 S $P(Y,";",6)=$S(SHOWSUB'="":SHOWSUB,1:0)
     12 Q
     13SVTIUCTX(Y,ORCTXT) ; Save new Notes view preferences for user
     14 N TMP
     15 S TMP=$$GET^XPAR(DUZ_";VA(200,","ORCH CONTEXT NOTES",1)
     16 I TMP'="" D  Q
     17 . D CHG^XPAR(DUZ_";VA(200,","ORCH CONTEXT NOTES",1,ORCTXT)
     18 D ADD^XPAR(DUZ_";VA(200,","ORCH CONTEXT NOTES",1,ORCTXT)
     19 Q
     20 ;
     21GTDCCTX(Y,ORUSER) ; Returns current DC Summary view context for user
     22 N OCCLIM,SHOWSUB
     23 S Y=$$GET^XPAR("ALL","ORCH CONTEXT SUMMRIES",1)
     24 I +$P(Y,";",5)=0 D
     25 . S OCCLIM=$P($$PERSPRF^TIULE(DUZ),U,10)
     26 . S:+OCCLIM>0 $P(Y,";",5)=OCCLIM
     27 S SHOWSUB=$P(Y,";",6)
     28 S $P(Y,";",6)=$S(SHOWSUB'="":SHOWSUB,1:0)
     29 Q
     30SVDCCTX(Y,ORCTXT) ; Save new DC Summary view preferences for user
     31 N TMP
     32 S TMP=$$GET^XPAR(DUZ_";VA(200,","ORCH CONTEXT SUMMRIES",1)
     33 I TMP'="" D  Q
     34 . D CHG^XPAR(DUZ_";VA(200,","ORCH CONTEXT SUMMRIES",1,ORCTXT)
     35 D ADD^XPAR(DUZ_";VA(200,","ORCH CONTEXT SUMMRIES",1,ORCTXT)
     36 Q
     37 ;
     38PRINTW(ORY,ORDA,ORFLG) ;TIU print to windows printer
     39 N ZTQUEUED,ORHFS,ORSUB,ORIO,ORSTATUS,ROOT,ORERR,ORWIN,ORHANDLE
     40 N IOM,IOSL,IOST,IOF,IOT,IOS
     41 S (ORSUB,ROOT)="ORDATA",ORIO="OR WINDOWS HFS",ORWIN=1,ORHANDLE="ORWTIU"
     42 S ORY=$NA(^TMP(ORSUB,$J,1))
     43 S ORHFS=$$HFS^ORWRP()
     44 D HFSOPEN^ORWRP(ORHANDLE,ORHFS,"W")
     45 I POP D  Q
     46 . I $D(ROOT) D SETITEM^ORWRP(.ROOT,"ERROR: Unable to open HFS file for TIU print")
     47 D IOVAR^ORWRP(.ORIO,,,"P-WINHFS80")
     48 N $ETRAP,$ESTACK
     49 S $ETRAP="D ERR^ORWRP Q"
     50 U IO
     51 D RPC^TIUPD(.ORERR,ORDA,ORIO,ORFLG,ORWIN)
     52 D HFSCLOSE^ORWRP(ORHANDLE,ORHFS)
     53 Q
     54GTLSTITM(ORY,ORTIUDA) ; Return single listbox item for document
     55 Q:+$G(ORTIUDA)=0
     56 S ORY=ORTIUDA_U_$$RESOLVE^TIUSRVLO(ORTIUDA)
     57 Q
     58IDNOTES(ORY)    ; Is ID Notes installed?
     59 S ORY=$$PATCH^XPDUTL("TIU*1.0*100")
     60 Q
     61CANLINK(ORY,ORTITLE)    ;Can the title be an ID child?
     62 ; DBIA #2322
     63 S ORY=$$CANLINK^TIULP(ORTITLE)
     64 Q
     65GETCP(ORY,ORTIUDA) ; Checks required CP fields before signature
     66 S ORY=""
     67 N ORTITLE,ORAUTH,ORCOS,ORPSUMCD,ORPROCDT,ORROOT,ORERR
     68 S ORERR="",ORROOT=$NA(^TMP("ORTIU",$J))
     69 D EXTRACT^TIULQ(ORTIUDA,.ORROOT,.ORERR,".01;1202;1208;70201;70202",,,"I")
     70 S ORTITLE=@ORROOT@(ORTIUDA,".01","I")
     71 S ORAUTH=@ORROOT@(ORTIUDA,"1202","I")
     72 S ORCOS=@ORROOT@(ORTIUDA,"1208","I")
     73 S ORPSUMCD=@ORROOT@(ORTIUDA,"70201","I")
     74 S ORPROCDT=@ORROOT@(ORTIUDA,"70202","I")
     75 S ORY=ORAUTH_U_ORCOS_U_ORPSUMCD_U_ORPROCDT_U_ORTITLE
     76 K @ORROOT
     77 Q
     78CHKTXT(ORY,ORTIUDA) ; Checks for presence of text before signature
     79 S ORY='$$EMPTYDOC^TIULF(ORTIUDA)  ;DBIA #4426
     80 Q
Note: See TracChangeset for help on using the changeset viewer.