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/IMAGING-MAG-ZMAG/MAGGNTI2.m

    r613 r623  
    1 MAGGNTI2        ;WOIFO/GEK - Imaging interface to TIU. RPC Calls etc. ; 04 Apr 2002  2:37 PM
    2         ;;3.0;IMAGING;**46,59**;Nov 27, 2007;Build 20
    3         ;;Per VHA Directive 2004-038, this routine should not be modified.
    4         ;; +---------------------------------------------------------------+
    5         ;; | Property of the US Government.        |
    6         ;; | No permission to copy or redistribute this software is given. |
    7         ;; | Use of unreleased versions of this software requires the user |
    8         ;; | to execute a written test agreement with the VistA Imaging |
    9         ;; | Development Office of the Department of Veterans Affairs,  |
    10         ;; | telephone (301) 734-0100.          |
    11         ;; | The Food and Drug Administration classifies this software as  |
    12         ;; | a medical device.  As such, it may not be changed in any way. |
    13         ;; | Modifications to this software may result in an adulterated   |
    14         ;; | medical device under 21CFR820, the use of which is considered |
    15         ;; | to be a violation of US Federal Statutes.      |
    16         ;; +---------------------------------------------------------------+
    17         ;;     
    18         Q
    19 LIST(MAGRY,CLASS,MYLIST)        ; RPC [MAG3 TIU LONG LIST OF TITLES]
    20         ; Get a list of Document Titles
    21         ; CLASS         = ("," delimited string of one or More of) "NOTE,DS,CONS,CP,SUR,<CLASS IEN>"
    22         ;                             CLASS IEN is any IEN of TIU 8925.1  that is a Class
    23         ;                "|" delimited string of Class| text | Direction
    24         ; MYLIST                = [1|""]   optional
    25         ;                               If MYLIST=1 then return
    26         ;                               TIU PERSONAL TITLE LIST       PERSLIST^TIUSRVD
    27         ;                                       
    28         ; Note : sending CLASS IEN isn't used in p59.
    29         ;
    30         K MAGRY
    31         ; was a Global, now leave it an Array, only getting 44
    32         N I,T,CL,CLN,CLNOTE,CLDS,CLCP,CLCONS,CLSUR,IL,J,TX,TXC,TX2,TX1,DFLT
    33         N INTXT,UPDN,TARR
    34         S MYLIST=$G(MYLIST)
    35         S INTXT=$P(CLASS,"|",2)
    36         S UPDN=$S(+$P(CLASS,"|",3):+$P(CLASS,"|",3),1:1)
    37         S CLASS=$P(CLASS,"|",1)
    38         I $L(CLASS)=0 S MAGRY(0)="0^Invalid Selection Class." Q
    39         S CLNOTE=3 ; It is hard coded in TIU code.  Note Class
    40         S CLDS=244 ; It is hard coded in TIU code.  Discharge Summary Class
    41         D CPCLASS^TIUCP(.CLCP)
    42         D CNSLCLAS^TIUSRVD(.CLCONS)
    43         D SURGCLAS^TIUSRVD(.CLSUR)
    44         S MAGRY(0)="0^Error: While accessing a list of Note Titles."
    45         S MAGRY(1)="key word^TITLE^CLASS"
    46         S I=""
    47         F I=1:1:$L(CLASS,",") D
    48         . S CL=$P(CLASS,",",I)
    49         . S CLN=$S(+CL:+CL,CL="NOTE":3,CL="DS":CLDS,CL="CP":CLCP,CL="CONS":CLCONS,CL="SUR":CLSUR,1:-1)
    50         . I MYLIST D  Q
    51         . . D MYLIST(CLN,.TARR)
    52         . . I $O(TARR(""))'="" S MAGRY(0)="1^Personal List"
    53         . . S J="" F  S J=$O(TARR(J)) Q:J=""  D
    54         . . . S TX1=$P(TARR(J),"^",1)
    55         . . . ; output has 'd' or 'i' as first character, we need to get rid of it.
    56         . . . I $E(TX1)="d" S DFLT=$E(TX1,2,999),MAGRY(0)=DFLT_"^Personal list"
    57         . . . S TX1=$E(TX1,2,999)
    58         . . . S TX=$P(TARR(J),"^",2),TX2=$P(TX,"<",2) S:$L(TX2) TX=$P(TX,"<",1) S:$L(TX2) TX2="<"_TX2
    59         . . . S MAGRY($O(MAGRY(""),-1)+1)=TX_"^"_TX2_"^"_CL_"|"_TX1
    60         . . . Q
    61         . . Q
    62         . ; here add line as a break between Personal List and Start of Total List
    63         . K TARR
    64         . D BLDLIST(CLN,.TARR,INTXT,UPDN)
    65         . S J="" F  S J=$O(TARR(J)) Q:J=""  D
    66         . . S TX=$P(TARR(J),"^",2),TX2=$P(TX,"<",2) S:$L(TX2) TX=$P(TX,"<",1) S:$L(TX2) TX2="<"_TX2
    67         . . S TX1=$P(TARR(J),"^",1)
    68         . . S MAGRY($O(MAGRY(""),-1)+1)=TX_"^"_TX2_"^"_CL_"|"_TX1
    69         . . Q
    70         . Q
    71         I '$D(MAGRY(2)) K MAGRY(1) S MAGRY(0)="0^0 Items match input: "_INTXT
    72         E  S MAGRY(0)="1^Success"_"^"_$G(DFLT)_"^"
    73         Q
    74         ;
    75 MYLIST(CLN,TARR)        ;
    76         ; if not short list, default is listed twice, (This is how CPRS displays it)
    77         K TARR
    78         D PERSLIST^TIUSRVD(.TARR,DUZ,CLN)
    79         Q
    80 BLDLIST(CLN,TARR,STC,UPDN)      ;
    81         ;
    82         S UPDN=$S(+$G(UPDN):+$G(UPDN),1:1)
    83         K TARR
    84         D LONGLIST^TIUSRVD(.TARR,CLN,STC,UPDN)
    85         Q
    86 ADMNCLOS(MAGRY,MAGDFN,MAGTIUDA,MAGMODE) ; calls TIU API to set as Admin Closed.
    87         ; RPC Call to Administratively Close a TIU Note. 
    88         ; - - - Required - - -
    89         ; MAGDFN    - Patient DFN
    90         ; MAGTIUDA  - Note IEN in File 8925
    91         ; - - - Optional - - -
    92         ; MAGMODE   - "S" Scanned Document "M" - Manual closure  "E" - Electronically Filed.
    93         ;
    94         S MAGDFN=$G(MAGDFN),MAGTIUDA=$G(MAGTIUDA),MAGMODE=$G(MAGMODE,"S")
    95         I '$$VALDATA(.MAGRY,MAGDFN,MAGTIUDA) Q
    96         ; Calling TIU SET ADMINISTRATIVE CLOSURE
    97         ; MAGMODE can be "S" for SCANNED DOCUMENT  <- HIMS may get this changed
    98         ;                                            to Electronically Filed.
    99         ;             or "M" for MANUAL CLOSURE or "E" for ELECTONICALL FILE 
    100         D ADMNCLOS^TIUSRVPT(.MAGRY,MAGTIUDA,MAGMODE)
    101         ;   on success MAGRY  = MAGTIUDA
    102         ;   on error   MAGRY  = 0^<message>
    103         I MAGRY S MAGRY=MAGRY_"^Success: Administrative Closure."
    104         Q
    105 VALES(X)        ; Validate the esig
    106         N MAGY S MAGY=0
    107         D HASH^XUSHSHP
    108         I X]"",(X=$P($G(^VA(200,+DUZ,20)),U,4)) S MAGY=1
    109         Q MAGY
    110 VALDATA(RY,MAGDFN,MAGTIUDA)     ; Validate the TIUDA and the DFN
    111         S MAGTIUDA=$G(MAGTIUDA),MAGDFN=$G(MAGDFN)
    112         I 'MAGDFN S RY="0^Invalid data: Patient DFN invalid: "_MAGDFN Q 0
    113         I '$D(^DPT(+MAGDFN,0)) S RY="0^Invalid data: Patient DFN invalid: "_MAGDFN Q 0
    114         I 'MAGTIUDA S RY="0^Invalid Note IEN: "_MAGTIUDA Q 0
    115         I '$D(^TIU(8925,MAGTIUDA,0)) S RY="0^Invalid Note IEN: "_MAGTIUDA Q 0
    116         I $P(^TIU(8925,MAGTIUDA,0),"^",2)'=MAGDFN S RY="0^Invalid Patient DFN: "_MAGDFN_" for Note: "_MAGTIUDA Q 0
    117         S RY="1^Validated OK."
    118         Q 1
     1MAGGNTI2 ;WOIFO/GEK - Imaging interface to TIU RPC Calls etc. ; 20 Nov 2006  12:18 PM
     2 ;;3.0;IMAGING;**46**;16-February-2007;;Build 1023
     3 ;; Per VHA Directive 2004-038, this routine should not be modified.
     4 ;; +---------------------------------------------------------------+
     5 ;; | Property of the US Government.                                |
     6 ;; | No permission to copy or redistribute this software is given. |
     7 ;; | Use of unreleased versions of this software requires the user |
     8 ;; | to execute a written test agreement with the VistA Imaging    |
     9 ;; | Development Office of the Department of Veterans Affairs,     |
     10 ;; | telephone (301) 734-0100.                                     |
     11 ;; | The Food and Drug Administration classifies this software as  |
     12 ;; | a medical device.  As such, it may not be changed in any way. |
     13 ;; | Modifications to this software may result in an adulterated   |
     14 ;; | medical device under 21CFR820, the use of which is considered |
     15 ;; | to be a violation of US Federal Statutes.                     |
     16 ;; +---------------------------------------------------------------+
     17 ;;
     18 Q
     19LIST(MAGRY,CLASS,MYLIST) ; RPC [MAG3 TIU LONG LIST OF TITLES]
     20 ; Get a list of Document Titles
     21 ; CLASS         = ("," delimited string of one or More of) "NOTE,DS,CONS,CP,SUR,<CLASS IEN>"
     22 ;                             CLASS IEN is any IEN of TIU 8925.1  that is a Class
     23 ;                "|" delimited string of Class| text | Direction
     24 ; MYLIST                = [1|""]   optional
     25 ;                               If MYLIST=1 then return
     26 ;                               TIU PERSONAL TITLE LIST       PERSLIST^TIUSRVD
     27 ;                                       
     28 ; Note : sending CLASS IEN isn't tested.
     29 ;
     30 K MAGRY
     31 ; was a Global, now leave it an Array, only getting 44
     32 N I,T,CL,CLN,CLNOTE,CLDS,CLCP,CLCONS,CLSUR,IL,J,TX,TXC,TX2,TX1,DFLT
     33 N INTXT,UPDN,TARR
     34 S MYLIST=$G(MYLIST)
     35 S INTXT=$P(CLASS,"|",2)
     36 S UPDN=$S(+$P(CLASS,"|",3):+$P(CLASS,"|",3),1:1)
     37 S CLASS=$P(CLASS,"|",1)
     38 I $L(CLASS)=0 S MAGRY(0)="0^Invalid Selection Class." Q
     39 S CLNOTE=3 ; It is hard coded in TIU code.  Note Class
     40 S CLDS=244 ; It is hard coded in TIU code.  Discharge Summary Class
     41 D CPCLASS^TIUCP(.CLCP)
     42 D CNSLCLAS^TIUSRVD(.CLCONS)
     43 D SURGCLAS^TIUSRVD(.CLSUR)
     44 S MAGRY(0)="0^Error: While accessing a list of Note Titles."
     45 S MAGRY(1)="key word^TITLE^CLASS"
     46 S I=""
     47 F I=1:1:$L(CLASS,",") D
     48 . S CL=$P(CLASS,",",I)
     49 . S CLN=$S(+CL:+CL,CL="NOTE":3,CL="DS":CLDS,CL="CP":CLCP,CL="CONS":CLCONS,CL="SUR":CLSUR,1:-1)
     50 . I MYLIST D  Q
     51 . . D MYLIST(CLN,.TARR)
     52 . . I $O(TARR(""))'="" S MAGRY(0)="1^Personal List"
     53 . . S J="" F  S J=$O(TARR(J)) Q:J=""  D
     54 . . . S TX1=$P(TARR(J),"^",1)
     55 . . . ; output has 'd' or 'i' as first character, we need to get rid of it.
     56 . . . I $E(TX1)="d" S DFLT=$E(TX1,2,999),MAGRY(0)=DFLT_"^Personal list"
     57 . . . S TX1=$E(TX1,2,999)
     58 . . . S TX=$P(TARR(J),"^",2),TX2=$P(TX,"<",2) S:$L(TX2) TX=$P(TX,"<",1) S:$L(TX2) TX2="<"_TX2
     59 . . . S MAGRY($O(MAGRY(""),-1)+1)=TX_"^"_TX2_"^"_CL_"|"_TX1
     60 . . . Q
     61 . . Q
     62 . ; here add line as a break between Personal List and Start of Total List
     63 . K TARR
     64 . D BLDLIST(CLN,.TARR,INTXT,UPDN)
     65 . S J="" F  S J=$O(TARR(J)) Q:J=""  D
     66 . . S TX=$P(TARR(J),"^",2),TX2=$P(TX,"<",2) S:$L(TX2) TX=$P(TX,"<",1) S:$L(TX2) TX2="<"_TX2
     67 . . S TX1=$P(TARR(J),"^",1)
     68 . . S MAGRY($O(MAGRY(""),-1)+1)=TX_"^"_TX2_"^"_CL_"|"_TX1
     69 . . Q
     70 . Q
     71 I '$D(MAGRY(2)) K MAGRY(1) S MAGRY(0)="0^0 Items match input: "_INTXT
     72 E  S MAGRY(0)="1^Success"_"^"_$G(DFLT)_"^"
     73 Q
     74 ;
     75MYLIST(CLN,TARR) ;
     76 ; if not short list, default is listed twice, (This is how CPRS displays it)
     77 K TARR
     78 D PERSLIST^TIUSRVD(.TARR,DUZ,CLN)
     79 Q
     80BLDLIST(CLN,TARR,STC,UPDN) ;
     81 ;
     82 S UPDN=$S(+$G(UPDN):+$G(UPDN),1:1)
     83 K TARR
     84 D LONGLIST^TIUSRVD(.TARR,CLN,STC,UPDN)
     85 Q
     86ADMNCLOS(MAGRY,MAGDFN,MAGTIUDA,MAGMODE) ; calls TIU API to set as Admin Closed.
     87 ; RPC Call to Administratively Close a TIU Note. 
     88 ; - - - Required - - -
     89 ; MAGDFN    - Patient DFN
     90 ; MAGTIUDA  - Note IEN in File 8925
     91 ; - - - Optional - - -
     92 ; MAGMODE   - "S" Scanned Document "M" - Manual closure  "E" - Electronically Filed.
     93 ;
     94 S MAGDFN=$G(MAGDFN),MAGTIUDA=$G(MAGTIUDA),MAGMODE=$G(MAGMODE,"S")
     95 I '$$VALDATA(.MAGRY,MAGDFN,MAGTIUDA) Q
     96 ; Calling TIU SET ADMINISTRATIVE CLOSURE
     97 ; MAGMODE can be "S" for SCANNED DOCUMENT  <- HIMS may get this changed
     98 ;                                            to Electronically Filed.
     99 ;             or "M" for MANUAL CLOSURE or "E" for ELECTONICALL FILE 
     100 D ADMNCLOS^TIUSRVPT(.MAGRY,MAGTIUDA,MAGMODE)
     101 ;   on success MAGRY  = MAGTIUDA
     102 ;   on error   MAGRY  = 0^<message>
     103 I MAGRY S MAGRY=MAGRY_"^Success: Administrative Closure."
     104 Q
     105VALES(X) ; Validate the esig
     106 N MAGY S MAGY=0
     107 D HASH^XUSHSHP
     108 I X]"",(X=$P($G(^VA(200,+DUZ,20)),U,4)) S MAGY=1
     109 Q MAGY
     110VALDATA(RY,MAGDFN,MAGTIUDA) ; Validate the TIUDA and the DFN
     111 S MAGTIUDA=$G(MAGTIUDA),MAGDFN=$G(MAGDFN)
     112 I 'MAGDFN S RY="0^Invalid data: Patient DFN invalid: "_MAGDFN Q 0
     113 I '$D(^DPT(+MAGDFN,0)) S RY="0^Invalid data: Patient DFN invalid: "_MAGDFN Q 0
     114 I 'MAGTIUDA S RY="0^Invalid Note IEN: "_MAGTIUDA Q 0
     115 I '$D(^TIU(8925,MAGTIUDA,0)) S RY="0^Invalid Note IEN: "_MAGTIUDA Q 0
     116 I $P(^TIU(8925,MAGTIUDA,0),"^",2)'=MAGDFN S RY="0^Invalid Patient DFN: "_MAGDFN_" for Note: "_MAGTIUDA Q 0
     117 S RY="1^Validated OK."
     118 Q 1
Note: See TracChangeset for help on using the changeset viewer.