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/CLINICAL_PROCEDURES-MD/MDAPI.m

    r613 r623  
    1 MDAPI   ; HOIFO/DP/NCA - CP API Calls ; [05-05-2003 10:28]
    2         ;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
    3         ; Description:
    4         ; These API's are for use by external packages communicating with CP.
    5         ;
    6         ; Integration Agreements:
    7         ; IA# 3378 [Subscription] Documents the APIs that external packages use to communicate with CP.
    8         ; IA# 3468 [Subscription] Use GMRCCP APIs.
    9         ;
    10 EXTDATA(MDPROC) ; [Procedure]
    11         ; Returns 0/1 for external data needed
    12         ; Called by Consults to determine status of consult ordered
    13         ;
    14         ; Input parameters
    15         ;  1. MDPROC [Literal/Required] CP Definition IEN
    16         ;
    17         Q:'$D(^MDS(702.01,+$G(MDPROC),0)) 0
    18         I +$P(^MDS(702.01,+$G(MDPROC),0),U,3)!($O(^(.1,0))) Q 1
    19         E  Q 0
    20         ;
    21 ISTAT(MDARR)    ; [Procedure] Called by Imaging to update status
    22         ; Input parameters
    23         ;  1. MDARR [Literal/Required] Array from Imaging
    24         ;
    25         ; Input: MDARR(0)="0^error message" or "1^success message"
    26         ;        MDARR(1)=TrackID  (CP;Transaction IEN)
    27         ;        MDARR(2)=Queue Number
    28         ;        MDARR(3..N)=Warnings
    29         N MDCON,MDCR,MDIEN,MDIENS,MDLP,MDSTAT,MDSTR,MDTIU,RESULTS
    30         Q:$G(MDARR(0))=""
    31         Q:$G(MDARR(1))=""
    32         Q:$P(MDARR(1),";")'="CP"
    33         Q:'(+$P(MDARR(1),";",2))
    34         S MDIEN=+$P(MDARR(1),";",2),MDIENS=MDIEN_","
    35         S MDSTAT=+$P(MDARR(0),"^")
    36         S DATA("TRANSACTION")=MDIEN
    37         ; Is it in error?
    38         I 'MDSTAT D  Q
    39         .D STATUS^MDRPCOT(MDIENS,2,$P(MDARR(0),"^",2))
    40         .S DATA("PKG")="IMAGING"
    41         .S DATA("MESSAGE")=$P(MDARR(0),"^",2) D RPC^MDRPCOT(.RESULTS,"ADDMSG",.DATA)
    42         .F MDLP=2:0 S MDLP=$O(MDARR(MDLP)) Q:'MDLP  I $G(MDARR(MDLP))'="" D
    43         ..S DATA("MESSAGE")=$$TRANS(MDARR(MDLP)) D RPC^MDRPCOT(.RESULTS,"ADDMSG",.DATA)
    44         .D IMGSTAT^MDRPCOT1(+MDIENS,2) Q
    45         ; Call Consults that Partial Result ready
    46         S MDCON=+$P(^MDD(702,MDIEN,0),"^",5),MDTIU=+$P(^(0),"^",6)
    47         S MDCR=$$UPDCONS^MDRPCOT1(MDCON,MDTIU)
    48         I +MDCR<0 D  Q
    49         .D STATUS^MDRPCOT(MDIENS,2,$P(MDCR,"^",2))
    50         .S DATA("PKG")="CONSULTS",DATA("MESSAGE")=$P(MDCR,"^",2)
    51         .D RPC^MDRPCOT(.RESULTS,"ADDMSG",.DATA)
    52         .Q
    53         ; Closeout the record
    54         D STATUS^MDRPCOT(MDIENS,3,"")
    55         ; Update Images Status
    56         D IMGSTAT^MDRPCOT1(+MDIENS,3)
    57         Q
    58         ;
    59 ITIU(RESULTS,DFN,CONSULT,VSTRING)       ; [Procedure] API for Vista Imaging
    60         ; This API enables VistA Imaging to retrieve/create a TIU note for
    61         ; a consult for attaching images to.
    62         ;
    63         ; RESULTS(0) will equal one of the following
    64         ;   IEN of the TIU note if successful
    65         ;   or on failure one of the following status messages
    66         ;   -1^No patient DFN
    67         ;   -1^No Consult IEN
    68         ;   -1^No VString
    69         ;   -1^Error in CP transaction
    70         ;   -1^Unable to create CP transaction
    71         ;   -1^Unable to create the TIU document
    72         ;   -1^No such consult for this patient.
    73         ;
    74         ; Input parameters
    75         ;  1. RESULTS [Reference/Required] Return array
    76         ;  2. DFN [Literal/Required] Patient IEN
    77         ;  3. CONSULT [Literal/Required] Consult IEN
    78         ;  4. VSTRING [Literal/Optional] VString data for TIU Note (Required to create new TIU note)
    79         ;
    80         ; Variables:
    81         ;  MDIEN: [Private] Returns IEN from UPDATE~DIE call
    82         ;  MDIENS: [Private] Scratch
    83         ;  MDNOTE: [Private] Scratch
    84         ;  MDTRANS: [Private] Contains IEN of CP transaction
    85         ;
    86         ; New private variables
    87         NEW MDIEN,MDIENS,MDNOTE,MDTRANS
    88         K ^TMP($J),^TMP("MDTIUST",$J)
    89         N MDD,MDN,MDTIUER,MDTST,MDNEWV,MDTIUD S (MDTIUD,MDTIUER,MDTST)=""
    90         I '$G(DFN) S RESULTS(0)="-1^No patient DFN" Q
    91         I '$G(CONSULT) S RESULTS(0)="-1^No Consult IEN" Q
    92         ; Look for existing transaction
    93         S MDTIUD=$$PREV^MDRPCOT(+CONSULT,"")
    94         I +MDTIUD S RESULTS(0)=+MDTIUD Q
    95         ; No transaction, must create one for this consult
    96         I $G(VSTRING)="" S RESULTS(0)="-1^No VString" Q
    97         D CPLIST^GMRCCP(DFN,,$NA(^TMP($J)))
    98         S MDX="" F  S MDX=$O(^TMP($J,MDX)) Q:'MDX  I $P(^(MDX),U,5)=CONSULT D  Q
    99         .D NOW^%DTC S MDD=%
    100         .S:$L(VSTRING,";")=1 VSTRING=";"_VSTRING
    101         .S MDNEWV=$$GETVSTR^MDRPCOT1(DFN,VSTRING,$P(^TMP($J,MDX),U,6),MDD)
    102         .S MDFDA(702,"+1,",.01)=DFN
    103         .S MDFDA(702,"+1,",.02)=MDD
    104         .S MDFDA(702,"+1,",.03)=DUZ
    105         .S MDFDA(702,"+1,",.04)=$P(^TMP($J,MDX),U,6)
    106         .S MDFDA(702,"+1,",.05)=CONSULT
    107         .S MDFDA(702,"+1,",.07)=$P(MDNEWV,";",3)_";"_$P(MDNEWV,";",2)_";"_$P(MDNEWV,";")
    108         .S MDFDA(702,"+1,",.09)=0
    109         .;Create the new transaction
    110         .D UPDATE^DIE("","MDFDA","MDIEN") I '$G(MDIEN(1)) D  Q
    111         ..S RESULTS(0)="-1^Unable to create CP transaction"
    112         .
    113         .;Create the new TIU Note
    114         .S MDIENS=MDIEN(1)_","
    115         .S MDN=$$NEWTIUN^MDRPCOT(+MDIENS)
    116         .S MDNOTE=$S(MDN:$$GET1^DIQ(702,+MDIENS,.06,"I"),1:0)
    117         .I 'MDNOTE D  Q
    118         ..N DA,DIK
    119         ..S RESULTS(0)="-1^Unable to create the TIU document"
    120         ..S DA=+MDIENS,DIK="^MDD(702," D ^DIK
    121         .S RESULTS(0)=MDNOTE
    122         Q
    123         ;
    124 TIUCOMP(MDNOTE) ; [Procedure] Post Signature action to complete transaction
    125         ; Input parameters
    126         ;  1. MDNOTE [Literal/Required] TIU IEN
    127         ;
    128         N MDFDA,MDRES
    129         S MDRES=$O(^MDD(702,"ATIU",MDNOTE,0))
    130         I $G(^MDD(702,+MDRES,0))="" Q 0
    131         I $P($G(^MDD(702,+MDRES,0)),"^",9)=3 Q 1
    132         S MDFDA(702,MDRES_",",.09)=3
    133         D FILE^DIE("","MDFDA")
    134         Q 1
    135         ;
    136 TIUDEL(MDNOTE)  ; [Procedure] TIU Note deletion Update
    137         ; Input parameters
    138         ;  1. MDNOTE [Literal/Required] TIU IEN
    139         ;
    140         N MDGBL,MDRES,MDFDA,MDTRAN,RESULTS
    141         S MDRES="" F  S MDRES=$O(^MDD(702,"ATIU",MDNOTE,MDRES)) Q:'MDRES  D
    142         .Q:$G(^MDD(702,+MDRES,0))=""
    143         .;S MDFDA(702,MDRES_",",.05)=""
    144         .S MDFDA(702,MDRES_",",.06)=""
    145         .D FILE^DIE("","MDFDA")
    146         .S MDTRAN=$O(^MDD(702.001,"ASTUDY",MDRES,MDNOTE,0)) I +MDTRAN N DA,DIK S DA=+MDTRAN,DIK="^MDD(702.001," D ^DIK
    147         .D STATUS^MDRPCOT(MDRES_",",2,"TIU note deleted.")
    148         .S DATA("TRANSACTION")=MDRES,DATA("PKG")="TIU"
    149         .S DATA("MESSAGE")="TIU note deleted." D RPC^MDRPCOT(.RESULTS,"ADDMSG",.DATA)
    150         S MDGBL=$NA(^MDD(702.001,"PK",MDNOTE)) F  S MDGBL=$Q(@MDGBL) Q:MDGBL=""  Q:$QS(MDGBL,2)'="PK"!($QS(MDGBL,3)'=MDNOTE)  S MDTRAN=$QS(MDGBL,6) N DA,DIK S DA=+MDTRAN,DIK="^MDD(702.001," D ^DIK
    151         Q 1
    152         ;
    153 TIUREAS(MDFN,MDOLDC,MDANOTE,MDNDFN,MDNEWC,MDNEWV,MDNTIU)        ; [Function] This is an API to clean up and update TIU note re-assignment.
    154         ; Input parameters
    155         ;  1. MDFN [Literal/Required] The Patient DFN whose TIU document is being re-assigned.
    156         ;  2. MDOLDC [Literal/Required] The Consult that the note is being re-assigned from.
    157         ;  3. MDANOTE [Literal/Required] The TIU Document IEN that is being re-assigned.
    158         ;  4. MDNDFN [Literal/Required] The Patient DFN who will be re-assigned the TIU document.
    159         ;  5. MDNEWC [Literal/Required] The consult number that will be assignment the TIU document.
    160         ;  6. MDNEWV [Literal/Required] The new visit for the TIU document assignment.
    161         ;  7. MDNTIU [Literal/Required] The new reassigned TIU document IEN.
    162         ;
    163         N MDD,MDGBL,MDTRAN,MDCHK,MDLP,MDMULN,MDN,MDPPR,MDREAS,MDTRANI,MDX
    164         I '$G(MDFN) Q "0^No DFN for the TIU note re-assignment."
    165         I '$G(MDOLDC) Q "0^No Old Consult # for the note re-assignment."
    166         I '$G(MDANOTE) Q "0^No TIU Note IEN."
    167         I '$G(MDNDFN) Q "0^No New DFN for the note assignment."
    168         I '$G(MDNEWC) Q "0^No New Consult # for the note assignment."
    169         I '$G(MDNTIU) Q "0^No New Reassigned TIU IEN."
    170         S (MDD,MDCHK,MDREAS,MDTRAN)="",MDPPR=0 K ^TMP("MDTMP",$J)
    171         S MDTRAN=$O(^MDD(702,"ATIU",MDANOTE,0)) I +MDTRAN S MDCHK=$G(^MDD(702,MDTRAN,0)),MDTRANI=MDTRAN_"," D
    172         .I $P(MDCHK,U,5)=MDOLDC&($P(MDCHK,U,6)=MDANOTE) D
    173         ..S MDFDA(702,+MDTRAN_",",.06)=""
    174         ..D FILE^DIE("","MDFDA") K MDFDA
    175         S MDGBL=$NA(^MDD(702.001,"PK",MDANOTE))
    176         F  S MDGBL=$Q(@MDGBL) Q:MDGBL=""  Q:$QS(MDGBL,2)'="PK"!($QS(MDGBL,3)'=MDANOTE)  S MDN=$QS(MDGBL,6) N DA,DIK S DA=+MDN,DIK="^MDD(702.001," D ^DIK
    177         S MDMULN=+$O(^MDD(702.001,"ASTUDY",+MDTRAN,0))
    178         I '+MDMULN I +MDTRAN N DA,DIK S DA=+MDTRAN,DIK="^MDD(702," D ^DIK
    179         D NOW^%DTC S MDD=% S MDTRANI=$O(^MDD(702,"ACON",MDNEWC,0))
    180         S MDREAS=$P(MDNEWV,";",3)_";"_$P(MDNEWV,";",2)_";"_$P(MDNEWV,";")
    181         I +MDTRANI&(MDNDFN=+$G(^MDD(702,+MDTRANI,0))) D
    182         .S MDPPR=$P($G(^MDD(702,+MDTRANI,0)),"^",4) Q:'MDPPR
    183         .S MDNEWV=$$GETVSTR^MDRPCOT1(MDNDFN,MDREAS,MDPPR,MDD)
    184         .S MDFDA(702,+MDTRANI_",",.06)=MDNTIU
    185         .S MDFDA(702,"+1,",.07)=$P(MDNEWV,";",3)_";"_$P(MDNEWV,";",2)_";"_$P(MDNEWV,";")
    186         .D FILE^DIE("","MDFDA") K MDFDA
    187         I 'MDPPR D
    188         .D CPLIST^GMRCCP(MDNDFN,,$NA(^TMP("MDTMP",$J)))
    189         .S MDX=""
    190         .F  S MDX=$O(^TMP("MDTMP",$J,MDX)) Q:'MDX  S:$P(^(MDX),U,5)=MDNEWC MDPPR=$P(^(MDX),U,6)
    191         K ^TMP("MDTMP",$J)
    192         I +MDPPR Q 1
    193         S MDNEWV=$$GETVSTR^MDRPCOT1(MDNDFN,MDREAS,MDPPR,MDD)
    194         S MDFDA(702,"+1,",.01)=MDNDFN
    195         S MDFDA(702,"+1,",.02)=MDD
    196         S MDFDA(702,"+1,",.03)=DUZ
    197         S MDFDA(702,"+1,",.04)=MDPPR
    198         S MDFDA(702,"+1,",.05)=MDNEWC
    199         S MDFDA(702,"+1,",.06)=MDNTIU
    200         S MDFDA(702,"+1,",.07)=$P(MDNEWV,";",3)_";"_$P(MDNEWV,";",2)_";"_$P(MDNEWV,";")
    201         S MDFDA(702,"+1,",.09)=0
    202         D UPDATE^DIE("","MDFDA")
    203         Q 1
    204         ;
    205 TRANS(STR)      ; [Function] Translate the upper arrows to blanks
    206         ; Input parameters
    207         ;  1. STR [Literal/Required] Input: Text with upper arrows that needs to be removed
    208         ;
    209         I STR["^" Q $TR(STR,"^"," ")
    210         Q STR
    211         ;
    212 GETCP(RESULTS,MDCSLT)   ; API to return CP Study data
    213         ; Input Parameters:
    214         ;   1. RESULTS [Literal/Required] Return Array
    215         ;   2. MDCSLT [Literal/Required] Consult number
    216         ;
    217         ; Output:
    218         ;   RESULTS(0)=-1^Error Message or 1 for success
    219         ;          (N,1)=CP Study Number
    220         ;          (N,2)=Patient DFN
    221         ;          (N,3)=Created Date/Time
    222         ;          (N,4)=Created By
    223         ;          (N,5)=CP Definition (External Name)
    224         ;          (N,6)=Consult Number
    225         ;          (N,7)=TIU Note IEN
    226         ;          (N,8)=VSTR
    227         ;          (N,9)=Transaction Status
    228         ;
    229         ; Where N = 1..n entries
    230         ;
    231         N MDCT,MDX,MDY
    232         I '$G(MDCSLT) S @RESULTS@(0)="-1^No Consult Number passed" Q
    233         S MDX=$O(^MDD(702,"ACON",MDCSLT,0)) I 'MDX S @RESULTS@(0)="-1^No CP Study Entry." Q
    234         S @RESULTS@(0)=1
    235         S MDCT=0,MDX="" F  S MDX=$O(^MDD(702,"ACON",MDCSLT,MDX)) Q:MDX<1  D
    236         .S MDCT=MDCT+1,@RESULTS@(MDCT,1)=MDX
    237         .S MDY=$G(^MDD(702,+MDX,0)),@RESULTS@(MDCT,2)=$P(MDY,U),@RESULTS@(MDCT,3)=$P(MDY,U,2),@RESULTS@(MDCT,4)=$P(MDY,U,3),@RESULTS@(MDCT,5)=$$GET1^DIQ(702,+MDX,.04,"E")
    238         .S @RESULTS@(MDCT,6)=$P(MDY,U,5),@RESULTS@(MDCT,7)=$P(MDY,U,6),@RESULTS@(MDCT,8)=$P(MDY,U,7),@RESULTS@(MDCT,9)=$$GET1^DIQ(702,+MDX,.09,"E")
    239         Q
     1MDAPI ; HOIFO/DP/NCA - CP API Calls ; [05-05-2003 10:28]
     2 ;;1.0;CLINICAL PROCEDURES;;Apr 01, 2004
     3 ; Description:
     4 ; These API's are for use by external packages communicating with CP.
     5 ;
     6 ; Integration Agreements:
     7 ; IA# 3378 [Restricted] Documents the APIs that external packages use to communicate with CP.
     8 ; IA# 3468 [Subscription] Use GMRCCP APIs.
     9 ;
     10EXTDATA(MDPROC) ; [Procedure]
     11 ; Returns 0/1 for external data needed
     12 ; Called by Consults to determine status of consult ordered
     13 ;
     14 ; Input parameters
     15 ;  1. MDPROC [Literal/Required] CP Definition IEN
     16 ;
     17 Q:'$D(^MDS(702.01,+$G(MDPROC),0)) 0
     18 I +$P(^MDS(702.01,+$G(MDPROC),0),U,3)!($O(^(.1,0))) Q 1
     19 E  Q 0
     20 ;
     21ISTAT(MDARR) ; [Procedure] Called by Imaging to update status
     22 ; Input parameters
     23 ;  1. MDARR [Literal/Required] Array from Imaging
     24 ;
     25 ; Input: MDARR(0)="0^error message" or "1^success message"
     26 ;        MDARR(1)=TrackID  (CP;Transaction IEN)
     27 ;        MDARR(2)=Queue Number
     28 ;        MDARR(3..N)=Warnings
     29 N MDCON,MDCR,MDIEN,MDIENS,MDLP,MDSTAT,MDSTR,MDTIU,RESULTS
     30 Q:$G(MDARR(0))=""
     31 Q:$G(MDARR(1))=""
     32 Q:$P(MDARR(1),";")'="CP"
     33 Q:'(+$P(MDARR(1),";",2))
     34 S MDIEN=+$P(MDARR(1),";",2),MDIENS=MDIEN_","
     35 S MDSTAT=+$P(MDARR(0),"^")
     36 S DATA("TRANSACTION")=MDIEN
     37 ; Is it in error?
     38 I 'MDSTAT D  Q
     39 .D STATUS^MDRPCOT(MDIENS,2,$P(MDARR(0),"^",2))
     40 .S DATA("PKG")="IMAGING"
     41 .S DATA("MESSAGE")=$P(MDARR(0),"^",2) D RPC^MDRPCOT(.RESULTS,"ADDMSG",.DATA)
     42 .F MDLP=2:0 S MDLP=$O(MDARR(MDLP)) Q:'MDLP  I $G(MDARR(MDLP))'="" D
     43 ..S DATA("MESSAGE")=$$TRANS(MDARR(MDLP)) D RPC^MDRPCOT(.RESULTS,"ADDMSG",.DATA)
     44 .D IMGSTAT^MDRPCOT1(+MDIENS,2) Q
     45 ; Call Consults that Partial Result ready
     46 S MDCON=+$P(^MDD(702,MDIEN,0),"^",5),MDTIU=+$P(^(0),"^",6)
     47 S MDCR=$$UPDCONS^MDRPCOT1(MDCON,MDTIU)
     48 I +MDCR<0 D  Q
     49 .D STATUS^MDRPCOT(MDIENS,2,$P(MDCR,"^",2))
     50 .S DATA("PKG")="CONSULTS",DATA("MESSAGE")=$P(MDCR,"^",2)
     51 .D RPC^MDRPCOT(.RESULTS,"ADDMSG",.DATA)
     52 .Q
     53 ; Closeout the record
     54 D STATUS^MDRPCOT(MDIENS,3,"")
     55 ; Update Images Status
     56 D IMGSTAT^MDRPCOT1(+MDIENS,3)
     57 Q
     58 ;
     59ITIU(RESULTS,DFN,CONSULT,VSTRING) ; [Procedure] API for Vista Imaging
     60 ; This API enables VistA Imaging to retrieve/create a TIU note for
     61 ; a consult for attaching images to.
     62 ;
     63 ; RESULTS(0) will equal one of the following
     64 ;   IEN of the TIU note if successful
     65 ;   or on failure one of the following status messages
     66 ;   -1^No patient DFN
     67 ;   -1^No Consult IEN
     68 ;   -1^No VString
     69 ;   -1^Error in CP transaction
     70 ;   -1^Unable to create CP transaction
     71 ;   -1^Unable to create the TIU document
     72 ;   -1^No such consult for this patient.
     73 ;
     74 ; Input parameters
     75 ;  1. RESULTS [Reference/Required] Return array
     76 ;  2. DFN [Literal/Required] Patient IEN
     77 ;  3. CONSULT [Literal/Required] Consult IEN
     78 ;  4. VSTRING [Literal/Optional] VString data for TIU Note (Required to create new TIU note)
     79 ;
     80 ; Variables:
     81 ;  MDIEN: [Private] Returns IEN from UPDATE~DIE call
     82 ;  MDIENS: [Private] Scratch
     83 ;  MDNOTE: [Private] Scratch
     84 ;  MDTRANS: [Private] Contains IEN of CP transaction
     85 ;
     86 ; New private variables
     87 NEW MDIEN,MDIENS,MDNOTE,MDTRANS
     88 K ^TMP($J),^TMP("MDTIUST",$J)
     89 N MDD,MDN,MDTIUER,MDTST,MDNEWV,MDTIUD S (MDTIUD,MDTIUER,MDTST)=""
     90 I '$G(DFN) S RESULTS(0)="-1^No patient DFN" Q
     91 I '$G(CONSULT) S RESULTS(0)="-1^No Consult IEN" Q
     92 ; Look for existing transaction
     93 S MDTIUD=$$PREV^MDRPCOT(+CONSULT,"")
     94 I +MDTIUD S RESULTS(0)=+MDTIUD Q
     95 ; No transaction, must create one for this consult
     96 I $G(VSTRING)="" S RESULTS(0)="-1^No VString" Q
     97 D CPLIST^GMRCCP(DFN,,$NA(^TMP($J)))
     98 S MDX="" F  S MDX=$O(^TMP($J,MDX)) Q:'MDX  I $P(^(MDX),U,5)=CONSULT D  Q
     99 .D NOW^%DTC S MDD=%
     100 .S:$L(VSTRING,";")=1 VSTRING=";"_VSTRING
     101 .S MDNEWV=$$GETVSTR^MDRPCOT1(DFN,VSTRING,$P(^TMP($J,MDX),U,6),MDD)
     102 .S MDFDA(702,"+1,",.01)=DFN
     103 .S MDFDA(702,"+1,",.02)=MDD
     104 .S MDFDA(702,"+1,",.03)=DUZ
     105 .S MDFDA(702,"+1,",.04)=$P(^TMP($J,MDX),U,6)
     106 .S MDFDA(702,"+1,",.05)=CONSULT
     107 .S MDFDA(702,"+1,",.07)=$P(MDNEWV,";",3)_";"_$P(MDNEWV,";",2)_";"_$P(MDNEWV,";")
     108 .S MDFDA(702,"+1,",.09)=0
     109 .;Create the new transaction
     110 .D UPDATE^DIE("","MDFDA","MDIEN") I '$G(MDIEN(1)) D  Q
     111 ..S RESULTS(0)="-1^Unable to create CP transaction"
     112 .
     113 .;Create the new TIU Note
     114 .S MDIENS=MDIEN(1)_","
     115 .S MDN=$$NEWTIUN^MDRPCOT(+MDIENS)
     116 .S MDNOTE=$S(MDN:$$GET1^DIQ(702,+MDIENS,.06,"I"),1:0)
     117 .I 'MDNOTE D  Q
     118 ..N DA,DIK
     119 ..S RESULTS(0)="-1^Unable to create the TIU document"
     120 ..S DA=+MDIENS,DIK="^MDD(702," D ^DIK
     121 .S RESULTS(0)=MDNOTE
     122 Q
     123 ;
     124TIUCOMP(MDNOTE) ; [Procedure] Post Signature action to complete transaction
     125 ; Input parameters
     126 ;  1. MDNOTE [Literal/Required] TIU IEN
     127 ;
     128 N MDFDA,MDRES
     129 S MDRES=$O(^MDD(702,"ATIU",MDNOTE,0))
     130 I $G(^MDD(702,+MDRES,0))="" Q 0
     131 I $P($G(^MDD(702,+MDRES,0)),"^",9)=3 Q 1
     132 S MDFDA(702,MDRES_",",.09)=3
     133 D FILE^DIE("","MDFDA")
     134 Q 1
     135 ;
     136TIUDEL(MDNOTE) ; [Procedure] TIU Note deletion Update
     137 ; Input parameters
     138 ;  1. MDNOTE [Literal/Required] TIU IEN
     139 ;
     140 N MDRES,MDFDA,RESULTS
     141 S MDRES="" F  S MDRES=$O(^MDD(702,"ATIU",MDNOTE,MDRES)) Q:'MDRES  D
     142 .Q:$G(^MDD(702,+MDRES,0))=""
     143 .S MDFDA(702,MDRES_",",.05)=""
     144 .S MDFDA(702,MDRES_",",.06)=""
     145 .D FILE^DIE("","MDFDA")
     146 .D STATUS^MDRPCOT(MDRES_",",2,"TIU note deleted.")
     147 .S DATA("TRANSACTION")=MDRES,DATA("PKG")="TIU"
     148 .S DATA("MESSAGE")="TIU note deleted." D RPC^MDRPCOT(.RESULTS,"ADDMSG",.DATA)
     149 Q 1
     150 ;
     151TIUREAS(MDFN,MDOLDC,MDANOTE,MDNDFN,MDNEWC,MDNEWV,MDNTIU) ; [Function] This is an API to clean up and update TIU note re-assignment.
     152 ; Input parameters
     153 ;  1. MDFN [Literal/Required] The Patient DFN whose TIU document is being re-assigned.
     154 ;  2. MDOLDC [Literal/Required] The Consult that the note is being re-assigned from.
     155 ;  3. MDANOTE [Literal/Required] The TIU Document IEN that is being re-assigned.
     156 ;  4. MDNDFN [Literal/Required] The Patient DFN who will be re-assigned the TIU document.
     157 ;  5. MDNEWC [Literal/Required] The consult number that will be assignment the TIU document.
     158 ;  6. MDNEWV [Literal/Required] The new visit for the TIU document assignment.
     159 ;  7. MDNTIU [Literal/Required] The new reassigned TIU document IEN.
     160 ;
     161 N MDD,MDTRAN,MDCHK,MDLP,MDPPR,MDREAS,MDTRANI,MDX
     162 I '$G(MDFN) Q "0^No DFN for the TIU note re-assignment."
     163 I '$G(MDOLDC) Q "0^No Old Consult # for the note re-assignment."
     164 I '$G(MDANOTE) Q "0^No TIU Note IEN."
     165 I '$G(MDNDFN) Q "0^No New DFN for the note assignment."
     166 I '$G(MDNEWC) Q "0^No New Consult # for the note assignment."
     167 I '$G(MDNTIU) Q "0^No New Reassigned TIU IEN."
     168 S (MDD,MDCHK,MDREAS,MDTRAN)="",MDPPR=0 K ^TMP("MDTMP",$J)
     169 F  S MDTRAN=$O(^MDD(702,"ACON",MDOLDC,MDTRAN)) Q:'MDTRAN  D
     170 .S MDCHK=$G(^MDD(702,MDTRAN,0)),MDTRANI=MDTRAN_","
     171 .I $P(MDCHK,U,5)=MDOLDC&($P(MDCHK,U,6)=MDANOTE) D
     172 ..S:'MDPPR MDPPR=$P(MDCHK,U,4)
     173 ..N DA,DIK S DA=+MDTRAN,DIK="^MDD(702," D ^DIK
     174 I 'MDPPR D
     175 .D CPLIST^GMRCCP(MDNDFN,,$NA(^TMP("MDTMP",$J)))
     176 .S MDX=""
     177 .F  S MDX=$O(^TMP("MDTMP",$J,MDX)) Q:'MDX  S:$P(^(MDX),U,5)=MDNEWC MDPPR=$P(^(MDX),U,6)
     178 K ^TMP("MDTMP",$J)
     179 I 'MDPPR Q 1
     180 D NOW^%DTC S MDD=%
     181 S MDREAS=$P(MDNEWV,";",3)_";"_$P(MDNEWV,";",2)_";"_$P(MDNEWV,";")
     182 S MDNEWV=$$GETVSTR^MDRPCOT1(MDNDFN,MDREAS,MDPPR,MDD)
     183 S MDFDA(702,"+1,",.01)=MDNDFN
     184 S MDFDA(702,"+1,",.02)=MDD
     185 S MDFDA(702,"+1,",.03)=DUZ
     186 S MDFDA(702,"+1,",.04)=MDPPR
     187 S MDFDA(702,"+1,",.05)=MDNEWC
     188 S MDFDA(702,"+1,",.06)=MDNTIU
     189 S MDFDA(702,"+1,",.07)=$P(MDNEWV,";",3)_";"_$P(MDNEWV,";",2)_";"_$P(MDNEWV,";")
     190 S MDFDA(702,"+1,",.09)=0
     191 D UPDATE^DIE("","MDFDA","MDTRANI") Q:'$G(MDTRANI(1)) 1
     192 Q 1
     193 ;
     194TRANS(STR) ; [Function] Translate the upper arrows to blanks
     195 ; Input parameters
     196 ;  1. STR [Literal/Required] Input: Text with upper arrows that needs to be removed
     197 ;
     198 I STR["^" Q $TR(STR,"^"," ")
     199 Q STR
     200 ;
Note: See TracChangeset for help on using the changeset viewer.