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

    r613 r623  
    1 ORWDBA3 ; SLC/GSS Billing Awareness (CIDC) [8/20/03 9:19am]
    2         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**190,195,243**;Dec 17, 1997;Build 242
    3         ;
    4 ORFMDAT(ORDFN)  ; Return date in FM format regarding order for CSV/CTD/HIPAA
    5         ; Pass in Order IEN
    6         Q ($P($G(^OR(100,ORDFN,8,1,0)),"^",16)\1)
    7         ;
    8 DISPLAY ; Display of BA data from original copied order (ORIT = ORIEN)
    9         ; Displayed in window with all order info and user can accept/edit
    10         ; Note: TxF = Treatment Factor
    11         ; BA data (Dx,TxF's) not editable but in signature window, not in above
    12         ; ORIT defined in ORWDXM1, DISPLAY called from ORWDXM2
    13         ;
    14         ; Input:
    15         ;  ORIT, ILST, and LST() from ORWDXM* routines
    16         ; Output:
    17         ;  ILST and LST() appropriately incremented/populated for order display
    18         ; Variables:
    19         ;  CUN     = TxF's in C, U, or N format
    20         ;  I       = counter
    21         ;  ILST    = line counter, initially from ORWDXM* routines
    22         ;  LST()   = array of lines to output, initially from ORWDXM* routines
    23         ;  NTF     = # of Treatment Factors
    24         ;  ORITARY = ORIT array of 1 needed to access GETTFCI^ORWDBA4
    25         ;  SPCS    = # of characters to space to left of ':'
    26         ;  TF1     = first TxF output? (0/1)
    27         ;  TFGBL   = TxF's in Global stored order
    28         ;  TFGUI   = TxF's in GUI returned order
    29         ;  TFV     = TxF verbiage
    30         ;
    31         N CUN,I,NTF,ORITARY,SPCS,TF1,TFGBL,TFGUI,TFV,Y
    32         S NTF=8,SPCS=28,ORITARY(1)=+ORIT
    33         ; Get Y(+ORIT) string in ORIEN^CUUUCCN^Dx1^Desc1^Dx2^Desc2^... format
    34         D GETTFCI^ORWDBA4(.Y,.ORITARY)
    35         S CUN=$P($G(Y(1)),U,2)  ;CUN = Treatment Factors in CUN syntax
    36         ; First output Diagnosis information - if any
    37         F I=3:2:9 I $P($G(Y(1)),U,I)'="" D
    38         . S ILST=ILST+1,LST(ILST)=$S(I=3:"Diagnoses",1:"")
    39         . S LST(ILST)=LST(ILST)_":"_$P(Y(1),U,I)_" - "_$P(Y(1),U,I+1)
    40         . D FRMTLST
    41         ; Get GUI and GBL Treatment Factor sequence strings
    42         D TFSTGS^ORWDBA1
    43         ; Assumes SC will always be first in sequence! - not likely to change
    44         S ILST=ILST+1
    45         S LST(ILST)="Service Connected:"_$S($E(CUN)="C":"YES",1:"NO")
    46         D FRMTLST
    47         S ILST=ILST+1,LST(ILST)="Treatment Factors:"
    48         ; If no TxF's (no 'C'hecked) {SC output above} then output '<none>'
    49         I '$F($E(CUN,2,NTF),"C") S LST(ILST)=LST(ILST)_"<none>" D FRMTLST Q
    50         S TF1=0  ;No TxF yet output
    51         ; Verbiage for TxF's
    52         S TFV("MST")="MILITARY SEXUAL TRAUMA",TFV("AO")="AGENT ORANGE"
    53         S TFV("IR")="IONIZING RADIATION",TFV("EC")="ENVIRONMENTAL CONTAMINANTS"
    54         S TFV("HNC")="HEAD AND NECK CANCER",TFV("CV")="COMBAT VETERAN"
    55         S TFV("SHD")="SHIPBOARD HAZARD"
    56         ; Output Checked TxF's
    57         F I=2:1:NTF I $E(CUN,I)="C" D
    58         . I 'TF1 S LST(ILST)=LST(ILST)_TFV($P(TFGUI,U,I)),TF1=1 D FRMTLST Q
    59         . S ILST=ILST+1,LST(ILST)=":"_TFV($P(TFGUI,U,I)) D FRMTLST
    60         Q
    61         ;
    62 FRMTLST ; Format the variable LST(ILST) for DISPLAY tag
    63         S LST(ILST)=$J($P(LST(ILST),":"),SPCS)_": "_$P(LST(ILST),":",2)
    64         Q
    65         ;
    66 HINTS(Y)        ; Return HINTS for ORBA Treatment Factors - used by Delphi
    67         ; The hints returned in the Y array will be used in the CPRS GUI and
    68         ; displayed on fly-over of the cursor over the TxF text in the window
    69         ;
    70         ; Input
    71         ;  <none>
    72         ; Output
    73         ;  Y array of the hints for TxF's> Y(#)=TxFA ^ TxF line # ^ hint text
    74         ;    where TxFA is Treatment Factor acronym, e.g., CV=Combat Veteran
    75         ; Variables
    76         ;  CT      = line number count, used in Y(#) where #=CT
    77         ;  I       = incrementor index #
    78         ;  ORTFIEN = the IEN for the TxF in the Help Frame (^DIC(9.2)) file
    79         ;  TF      = TxF acronym
    80         ;  TFLN    = TxF text line number, e.g., ^DIC(9.2,ORTFIEN,1,TFLN,0)
    81         ;  TFS     = string of TxF acronyms
    82         ;  TFV     = TxF description/text
    83         ;
    84         N CT,I,ORTFIEN,TF,TFLN,TFS,TFV
    85         ;
    86         S TFS="SC^MST^AO^IR^EC^HNC^CV^SHD",CT=0
    87         ; Get next TxF from TFS
    88         F I=1:1 S TF=$P(TFS,U,I) Q:TF=""  D
    89         . S ORTFIEN=$O(^DIC(9.2,"B","ORBA-"_TF,"")),TFV="",TFLN=0
    90         . ; Get next line of hint text
    91         . F  S TFLN=$O(^DIC(9.2,ORTFIEN,1,TFLN)) Q:'TFLN  D
    92         .. S CT=CT+1,Y(CT)=TF_U_TFLN_U_^DIC(9.2,ORTFIEN,1,TFLN,0)
    93         Q
    94         ;
    95 DG1(ORDFN,COUNTER,CTVALUE)      ; Create DG1 segment(s) & make call for ZCL seg.
    96         ;
    97         ;  Input
    98         ;    ORDFN      Internal Order ID#
    99         ;    COUNTER    Variable used as counter from calling routine
    100         ;    CTVALUE    Value of COUNTER when DG1 called
    101         ;  Output
    102         ;    DG1 & ZCL HL7 segments
    103         ;
    104         I $$BASTAT^ORWDBA1=0 Q  ;BA not used
    105         N DG13,DXIEN,DXR,DXV,FROMFILE,ICD9,OCT,OREC,ORFMDAT
    106         ; zero order count variable
    107         S OCT=0
    108         ; Get the date of order (for CSV/CTD usage)
    109         S ORFMDAT=$$ORFMDAT(ORDFN)
    110         ; Get the diagnoses for an order
    111         F  S OCT=$O(^OR(100,ORDFN,5.1,OCT)) Q:OCT'?1N.N  D
    112         . S OREC=^OR(100,ORDFN,5.1,OCT,0)
    113         . S DXIEN=$P(OREC,U)  ; DXIEN=pointer to diagnosis (ICD9) file #80
    114         . ; the DXIEN pointer should point to a valid diagnosis (after all is
    115         . ;   was previously entered .. but just in case ...)
    116         . S (DXV,ICD9)=""
    117         . I DXIEN'="" D
    118         .. S DXR=$$ICDDX^ICDCODE(DXIEN,ORFMDAT) Q:+DXR=-1
    119         .. ; Get diagnosis verbiage and ICD code
    120         .. S DXV=$P(DXR,U,4),ICD9=$P(DXR,U,2)
    121         . S FROMFILE=80
    122         . S DG13=DXIEN_U_DXV_U_FROMFILE_U_ICD9_U_DXV_U_"ICD9"
    123         . S CTVALUE=CTVALUE+1
    124         . S ORMSG(CTVALUE)="DG1"_"|"_OCT_"||"_DG13_"|||||||||||||"
    125         . D ZCL
    126         S @COUNTER=CTVALUE
    127         Q
    128         ;
    129 ZCL     ;create all the ZCL segments (currently 8 TxF's) for order number OCT
    130         ;
    131         N I,J,TABLE,TF,TFGBL,TFGUI,TFTBL,TFIN,TFS,VALUE
    132         D TFSTGS^ORWDBA1  ;set string sequence of treatment factors
    133         ; TFS is TxF data in ^OR(100,ORIEN,5.2) order
    134         S TFS=$G(^OR(100,ORDFN,5.2)),TABLE=""
    135         ; conversion order from ^OR stored data and Table SD008 for HL7 msg
    136         ; convert so that the ZCL segments will be in Table SD008 order (1-8)
    137         F I=1:1:8 S TF=$P(TFTBL,U,I) F J=1:1:8 I $P(TFGBL,U,J)=TF S TABLE=TABLE_J Q
    138         F TFIN=1:1:8 D
    139         . ; ORMSG counter incremented
    140         . S CTVALUE=CTVALUE+1
    141         . ; TF VALUE=0 for no or 1 for yes (only if not req. is it null)
    142         . S VALUE=$P(TFS,U,$E(TABLE,TFIN))
    143         . I VALUE="?" S VALUE=0  ;temp fix if sending '?' to ancillary???
    144         . ; for Table SD008: OCT=Set ID, SCIN=O/P Classif. Type, VALUE=Value
    145         . S ORMSG(CTVALUE)="ZCL|"_OCT_"|"_TFIN_"|"_VALUE
    146         Q
    147         ;
    148 BDOSTR  ;Store backdoor order DG1 and ZCL messages from HL7
    149         ;Processes one order per entry into BDOSTR, e.g., ROUT(1)
    150         ;Depends upon ORM* routines to set-up a number of variables including
    151         ;  ORMSG array and ORIFN.
    152         ;ORM* routines calling BDOSTR: ORMGMRC, ORMLR, ORMPS, & ORMRA
    153         ;
    154         ; Input:   HL7 messages and related data
    155         ; Output:  ROUT array in Delphi GUI format, i.e.
    156         ;          OrderIEN;11CNNNCNN^exDx1^exDx2^exDx3^exDx4
    157         ;
    158         ; Variables Used
    159         ;  DG1      = sequential numbered array with a value of DXIEN
    160         ;  I,J      = counters
    161         ;  GUITF    = GUI order treatment factors (TxF)
    162         ;  NDX      = number of diagnoses being passed
    163         ;  NTF      = number of TxF
    164         ;  OBX      = @ORMSG Dx array element # (max of 4 diagnoses stored)
    165         ;  REC      = set to sequential HL7 messages, contains HL7 message data
    166         ;  ROUT     = record sent for storage processing to RCVORCI
    167         ;  TF       = individual TxF values
    168         ;  TFGBL    = TxF acronyms in ^ delimited string in ^OR sequence
    169         ;  TFGUI    = TxF acronyms in ^ delimited string in from GUI sequence
    170         ;  TFTBL    = TxF acronyms in ^ delimited string in Table SD008 sequence
    171         ;  VAL      = individual TxF values
    172         ;  ZCL      = TxF in Table SD008 format and sequence
    173         ;
    174         ; See if CIDC master switch set, if not then no DG1/ZCL seg, to store
    175         I $$BASTAT^ORWDBA1=0 Q  ;CIDC (nee BA) not used
    176         ;
    177         N CPNODE,CT,DG1,I,J,GUITF,NDX,NTF,OBX,REC,ROUT,ORSDCARY,SDCARYA
    178         N TF,TFGBL,TFGUI,TFTBL,VAL,X,ZCL
    179         ;
    180         K ORSDCARY,SDCARYA
    181         D TFSTGS^ORWDBA1  ;set string sequence of treatment factors
    182         S (CT,NDX,OBX)=0,NTF=8,(CPNODE,GUITF,TF,Y,ZCL)="",X="T"
    183         ; Call API to acquire Treatment Factors in force
    184         D NOW^%DTC,CL^SDCO21(DFN,%,"",.ORSDCARY)  ;DBIA 406
    185         ; Retrved array order: AO,IR,SC,EC,MST,HNC,CV,SHD, e.g., ORSDCARY(3) for SC
    186         ; Convert to character array, e.g., SDCARYA("SC")=""
    187         F I=1:1:NTF S:$D(ORSDCARY(I)) SDCARYA($P("AO^IR^SC^EC^MST^HNC^CV^SHD",U,I))=""
    188         ; Process only four DG1 segments and first set of ZCL segments
    189         F  S OBX=$O(@ORMSG@(OBX)) Q:OBX'>0  S J=$E(@ORMSG@(OBX),1,3) I J="DG1"!(J="ZCL"&($P(@ORMSG@(OBX),"|",2)=1)) D
    190         . S REC=@ORMSG@(OBX)
    191         . ; Setting DG1(#)=DXIEN where # is Dx sequence # (1=primary)
    192         . I J="DG1"&(NDX<4) S DG1($P(REC,"|",2))=$P(REC,U,4),NDX=NDX+1 Q
    193         . ; Create ZCL string of TxFs, e.g., 1101011
    194         . I J="ZCL" D
    195         .. S:$P(REC,"|",4)="" $P(REC,"|",4)=" "
    196         .. S $E(ZCL,$P(REC,"|",3))=$P(REC,"|",4)
    197         ; convert order and format from Table SD008 to GUI
    198         F I=1:1:NTF S TF=$P(TFGUI,U,I) F J=1:1:NTF I $P(TFTBL,U,J)=TF D
    199         . ; If patient does not have that Tx Factor (TF) then ghost in GUI ("N")
    200         . I '$D(SDCARYA(TF)) S GUITF=GUITF_"N" Q
    201         . ; If patient has TF then format for GUI (C=ck'd, U=unck'd, ?=not ans)
    202         . S VAL=$E(ZCL,J),GUITF=GUITF_$S(VAL=1:"C",VAL=0:"U",1:"?")
    203         ; Create output string in a format that can be stored by RCVORCI^ORWDBA1
    204         S ROUT(1)=ORIFN_";11"_GUITF_U_$G(DG1(1))_U_$G(DG1(2))_U_$G(DG1(3))_U_$G(DG1(4))
    205         ; Store diagnoses and treatment factors
    206         D RCVORCI^ORWDBA1(Y,.ROUT)
    207         Q
    208         ;
    209 ERRMSG(VISIT)   ; Error handling and message
    210         ; to be determined
    211         Q
     1ORWDBA3 ; SLC/GSS Billing Awareness (CIDC) [8/20/03 9:19am]
     2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**190,195**;Dec 17, 1997
     3 ;
     4ORFMDAT(ORDFN) ; Return date in FM format regarding order for CSV/CTD/HIPAA
     5 ; Pass in Order IEN
     6 Q ($P($G(^OR(100,ORDFN,8,1,0)),"^",16)\1)
     7 ;
     8DISPLAY ; Display of BA data from original copied order (ORIT = ORIEN)
     9 ; Displayed in window with all order info and user can accept/edit
     10 ; Note: TxF = Treatment Factor
     11 ; BA data (Dx,TxF's) not editable but in signature window, not in above
     12 ; ORIT defined in ORWDXM1, DISPLAY called from ORWDXM2
     13 ;
     14 ; Input:
     15 ;  ORIT, ILST, and LST() from ORWDXM* routines
     16 ; Output:
     17 ;  ILST and LST() appropriately incremented/populated for order display
     18 ; Variables:
     19 ;  CUN     = TxF's in C, U, or N format
     20 ;  I       = counter
     21 ;  ILST    = line counter, initially from ORWDXM* routines
     22 ;  LST()   = array of lines to output, initially from ORWDXM* routines
     23 ;  NTF     = # of Treatment Factors
     24 ;  ORITARY = ORIT array of 1 needed to access GETTFCI^ORWDBA4
     25 ;  SPCS    = # of characters to space to left of ':'
     26 ;  TF1     = first TxF output? (0/1)
     27 ;  TFGBL   = TxF's in Global stored order
     28 ;  TFGUI   = TxF's in GUI returned order
     29 ;  TFV     = TxF verbiage
     30 ;
     31 N CUN,I,NTF,ORITARY,SPCS,TF1,TFGBL,TFGUI,TFV,Y
     32 S NTF=7,SPCS=28,ORITARY(1)=+ORIT
     33 ; Get Y(+ORIT) string in ORIEN^CUUUCCN^Dx1^Desc1^Dx2^Desc2^... format
     34 D GETTFCI^ORWDBA4(.Y,.ORITARY)
     35 S CUN=$P($G(Y(1)),U,2)  ;CUN = Treatment Factors in CUN syntax
     36 ; First output Diagnosis information - if any
     37 F I=3:2:9 I $P($G(Y(1)),U,I)'="" D
     38 . S ILST=ILST+1,LST(ILST)=$S(I=3:"Diagnoses",1:"")
     39 . S LST(ILST)=LST(ILST)_":"_$P(Y(1),U,I)_" - "_$P(Y(1),U,I+1)
     40 . D FRMTLST
     41 ; Get GUI and GBL Treatment Factor sequence strings
     42 D TFSTGS^ORWDBA1
     43 ; Assumes SC will always be first in sequence! - not likely to change
     44 S ILST=ILST+1
     45 S LST(ILST)="Service Connected:"_$S($E(CUN)="C":"YES",1:"NO")
     46 D FRMTLST
     47 S ILST=ILST+1,LST(ILST)="Treatment Factors:"
     48 ; If no TxF's (no 'C'hecked) {SC output above} then output '<none>'
     49 I '$F($E(CUN,2,NTF),"C") S LST(ILST)=LST(ILST)_"<none>" D FRMTLST Q
     50 S TF1=0  ;No TxF yet output
     51 ; Verbiage for TxF's
     52 S TFV("MST")="MILITARY SEXUAL TRAUMA",TFV("AO")="AGENT ORANGE"
     53 S TFV("IR")="IONIZING RADIATION",TFV("EC")="ENVIRONMENTAL CONTAMINANTS"
     54 S TFV("HNC")="HEAD AND NECK CANCER",TFV("CV")="COMBAT VETERAN"
     55 ; Output Checked TxF's
     56 F I=2:1:NTF I $E(CUN,I)="C" D
     57 . I 'TF1 S LST(ILST)=LST(ILST)_TFV($P(TFGUI,U,I)),TF1=1 D FRMTLST Q
     58 . S ILST=ILST+1,LST(ILST)=":"_TFV($P(TFGUI,U,I)) D FRMTLST
     59 Q
     60 ;
     61FRMTLST ; Format the variable LST(ILST) for DISPLAY tag
     62 S LST(ILST)=$J($P(LST(ILST),":"),SPCS)_": "_$P(LST(ILST),":",2)
     63 Q
     64 ;
     65HINTS(Y) ; Return HINTS for ORBA Treatment Factors - used by Delphi
     66 ; The hints returned in the Y array will be used in the CPRS GUI and
     67 ; displayed on fly-over of the cursor over the TxF text in the window
     68 ;
     69 ; Input
     70 ;  <none>
     71 ; Output
     72 ;  Y array of the hints for TxF's> Y(#)=TxFA ^ TxF line # ^ hint text
     73 ;    where TxFA is Treatment Factor acronym, e.g., CV=Combat Veteran
     74 ; Variables
     75 ;  CT      = line number count, used in Y(#) where #=CT
     76 ;  I       = incrementor index #
     77 ;  ORTFIEN = the IEN for the TxF in the Help Frame (^DIC(9.2)) file
     78 ;  TF      = TxF acronym
     79 ;  TFLN    = TxF text line number, e.g., ^DIC(9.2,ORTFIEN,1,TFLN,0)
     80 ;  TFS     = string of TxF acronyms
     81 ;  TFV     = TxF description/text
     82 ;
     83 N CT,I,ORTFIEN,TF,TFLN,TFS,TFV
     84 ;
     85 S TFS="SC^MST^AO^IR^EC^HNC^CV",CT=0
     86 ; Get next TxF from TFS
     87 F I=1:1 S TF=$P(TFS,U,I) Q:TF=""  D
     88 . S ORTFIEN=$O(^DIC(9.2,"B","ORBA-"_TF,"")),TFV="",TFLN=0
     89 . ; Get next line of hint text
     90 . F  S TFLN=$O(^DIC(9.2,ORTFIEN,1,TFLN)) Q:'TFLN  D
     91 .. S CT=CT+1,Y(CT)=TF_U_TFLN_U_^DIC(9.2,ORTFIEN,1,TFLN,0)
     92 Q
     93 ;
     94DG1(ORDFN,COUNTER,CTVALUE) ; Create DG1 segment(s) & make call for ZCL seg.
     95 ;
     96 ;  Input
     97 ;    ORDFN      Internal Order ID#
     98 ;    COUNTER    Variable used as counter from calling routine
     99 ;    CTVALUE    Value of COUNTER when DG1 called
     100 ;  Output
     101 ;    DG1 & ZCL HL7 segments
     102 ;
     103 I $$BASTAT^ORWDBA1=0 Q  ;BA not used
     104 N DG13,DXIEN,DXR,DXV,FROMFILE,ICD9,OCT,OREC,ORFMDAT
     105 ; zero order count variable
     106 S OCT=0
     107 ; Get the date of order (for CSV/CTD usage)
     108 S ORFMDAT=$$ORFMDAT(ORDFN)
     109 ; Get the diagnoses for an order
     110 F  S OCT=$O(^OR(100,ORDFN,5.1,OCT)) Q:OCT'?1N.N  D
     111 . S OREC=^OR(100,ORDFN,5.1,OCT,0)
     112 . S DXIEN=$P(OREC,U)  ; DXIEN=pointer to diagnosis (ICD9) file #80
     113 . ; the DXIEN pointer should point to a valid diagnosis (after all is
     114 . ;   was previously entered .. but just in case ...)
     115 . S (DXV,ICD9)=""
     116 . I DXIEN'="" D
     117 .. S DXR=$$ICDDX^ICDCODE(DXIEN,ORFMDAT) Q:+DXR=-1
     118 .. ; Get diagnosis verbiage and ICD code
     119 .. S DXV=$P(DXR,U,4),ICD9=$P(DXR,U,2)
     120 . S FROMFILE=80
     121 . S DG13=DXIEN_U_DXV_U_FROMFILE_U_ICD9_U_DXV_U_"ICD9"
     122 . S CTVALUE=CTVALUE+1
     123 . S ORMSG(CTVALUE)="DG1"_"|"_OCT_"||"_DG13_"|||||||||||||"
     124 . D ZCL
     125 S @COUNTER=CTVALUE
     126 Q
     127 ;
     128ZCL ;create all the ZCL segments (currently 7 TxF's) for order number OCT
     129 ;
     130 N I,J,TABLE,TF,TFGBL,TFGUI,TFTBL,TFIN,TFS,VALUE
     131 D TFSTGS^ORWDBA1  ;set string sequence of treatment factors
     132 ; TFS is TxF data in ^OR(100,ORIEN,5.2) order
     133 S TFS=$G(^OR(100,ORDFN,5.2)),TABLE=""
     134 ; conversion order from ^OR stored data and Table SD008 for HL7 msg
     135 ; convert so that the ZCL segments will be in Table SD008 order (1-7)
     136 F I=1:1:7 S TF=$P(TFTBL,U,I) F J=1:1:7 I $P(TFGBL,U,J)=TF S TABLE=TABLE_J Q
     137 F TFIN=1:1:7 D
     138 . ; ORMSG counter incremented
     139 . S CTVALUE=CTVALUE+1
     140 . ; TF VALUE=0 for no or 1 for yes (only if not req. is it null)
     141 . S VALUE=$P(TFS,U,$E(TABLE,TFIN))
     142 . I VALUE="?" S VALUE=0  ;temp fix if sending '?' to ancillary???
     143 . ; for Table SD008: OCT=Set ID, SCIN=O/P Classif. Type, VALUE=Value
     144 . S ORMSG(CTVALUE)="ZCL|"_OCT_"|"_TFIN_"|"_VALUE
     145 Q
     146 ;
     147BDOSTR ;Store backdoor order DG1 and ZCL messages from HL7
     148 ;Processes one order per entry into BDOSTR, e.g., ROUT(1)
     149 ;Depends upon ORM* routines to set-up a number of variables including
     150 ;  ORMSG array and ORIFN.
     151 ;ORM* routines calling BDOSTR: ORMGMRC, ORMLR, ORMPS, & ORMRA
     152 ;
     153 ; Input:   HL7 messages and related data
     154 ; Output:  ROUT array in Delphi GUI format, i.e.
     155 ;          OrderIEN;11CNNNCNN^exDx1^exDx2^exDx3^exDx4
     156 ;
     157 ; Variables Used
     158 ;  DG1      = sequential numbered array with a value of DXIEN
     159 ;  I,J      = counters
     160 ;  GUITF    = GUI order treatment factors (TxF)
     161 ;  NDX      = number of diagnoses being passed
     162 ;  NTF      = number of TxF
     163 ;  OBX      = @ORMSG Dx array element # (max of 4 diagnoses stored)
     164 ;  REC      = set to sequential HL7 messages, contains HL7 message data
     165 ;  ROUT     = record sent for storage processing to RCVORCI
     166 ;  TF       = individual TxF values
     167 ;  TFGBL    = TxF acronyms in ^ delimited string in ^OR sequence
     168 ;  TFGUI    = TxF acronyms in ^ delimited string in from GUI sequence
     169 ;  TFTBL    = TxF acronyms in ^ delimited string in Table SD008 sequence
     170 ;  VAL      = individual TxF values
     171 ;  ZCL      = TxF in Table SD008 format and sequence
     172 ;
     173 ; See if CIDC master switch set, if not then no DG1/ZCL seg, to store
     174 I $$BASTAT^ORWDBA1=0 Q  ;CIDC (nee BA) not used
     175 ;
     176 N CPNODE,CT,DG1,I,J,GUITF,NDX,NTF,OBX,REC,ROUT,ORSDCARY,SDCARYA
     177 N TF,TFGBL,TFGUI,TFTBL,VAL,X,ZCL
     178 ;
     179 K ORSDCARY,SDCARYA
     180 D TFSTGS^ORWDBA1  ;set string sequence of treatment factors
     181 S (CT,NDX,OBX)=0,NTF=7,(CPNODE,GUITF,TF,Y,ZCL)="",X="T"
     182 ; Call API to acquire Treatment Factors in force
     183 D NOW^%DTC,CL^SDCO21(DFN,%,"",.ORSDCARY)  ;DBIA 406
     184 ; Retrved array order: AO,IR,SC,EC,MST,HNC,CV, e.g., ORSDCARY(3) for SC
     185 ; Convert to character array, e.g., SDCARYA("SC")=""
     186 F I=1:1:NTF S:$D(ORSDCARY(I)) SDCARYA($P("AO^IR^SC^EC^MST^HNC^CV",U,I))=""
     187 ; Process only four DG1 segments and first set of ZCL segments
     188 F  S OBX=$O(@ORMSG@(OBX)) Q:OBX'>0  S J=$E(@ORMSG@(OBX),1,3) I J="DG1"!(J="ZCL"&($P(@ORMSG@(OBX),"|",2)=1)) D
     189 . S REC=@ORMSG@(OBX)
     190 . ; Setting DG1(#)=DXIEN where # is Dx sequence # (1=primary)
     191 . I J="DG1"&(NDX<4) S DG1($P(REC,"|",2))=$P(REC,U,4),NDX=NDX+1 Q
     192 . ; Create ZCL string of TxFs, e.g., 1101011
     193 . I J="ZCL" D
     194 .. S:$P(REC,"|",4)="" $P(REC,"|",4)=" "
     195 .. S $E(ZCL,$P(REC,"|",3))=$P(REC,"|",4)
     196 ; convert order and format from Table SD008 to GUI
     197 F I=1:1:NTF S TF=$P(TFGUI,U,I) F J=1:1:NTF I $P(TFTBL,U,J)=TF D
     198 . ; If patient does not have that Tx Factor (TF) then ghost in GUI ("N")
     199 . I '$D(SDCARYA(TF)) S GUITF=GUITF_"N" Q
     200 . ; If patient has TF then format for GUI (C=ck'd, U=unck'd, ?=not ans)
     201 . S VAL=$E(ZCL,J),GUITF=GUITF_$S(VAL=1:"C",VAL=0:"U",1:"?")
     202 ; Create output string in a format that can be stored by RCVORCI^ORWDBA1
     203 S ROUT(1)=ORIFN_";11"_GUITF_U_$G(DG1(1))_U_$G(DG1(2))_U_$G(DG1(3))_U_$G(DG1(4))
     204 ; Store diagnoses and treatment factors
     205 D RCVORCI^ORWDBA1(Y,.ROUT)
     206 Q
     207 ;
     208ERRMSG(VISIT) ; Error handling and message
     209 ; to be determined
     210 Q
Note: See TracChangeset for help on using the changeset viewer.