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

    r613 r623  
    1 ORWDBA7 ;;SLC/GSS Billing Awareness (CIDC-Clinical Indicators Data Capture)
    2         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**195,215,243**;Dec 17, 1997;Build 242
    3         ;
    4 BDOEDIT ; Backdoor entered orders edit in CPRS - entry point
    5         ; Data Flow> Ancillary creates a back door order which is incomplete
    6         ;            and thus edited in CPRS GUI. The ancillary needs to know
    7         ;            what Dx and TF's are edited thus this tag calls three
    8         ;            ancillary APIs, passing the Dx and TF data to them.
    9         ;
    10         ; Variable  Description
    11         ; ANCILARY  Acronym of ancillary/package relative to order
    12         ; DXN       Diagnosis sequence number in ^OR file
    13         ; MSG       Error message
    14         ; ORDX      Array of diagnoses (1-n) with value from ICD file (#80)
    15         ; ORIFN     Order internal reference number (defined in ORCSEND)
    16         ; ORITEM    Package reference or ^OR(100,ORIFN,4)
    17         ; ORSCEI    String of Treatment Factors in table SD008 order/format
    18         ; PTIEN     Patient IEN
    19         ; TAGROU    Tag^Routine of ancillary routine to store edited data
    20         ; TFO       Treatment Factors in ^OR (GBL) order
    21         ;
    22         ; If CIDC master switch set, then no back door orders to store
    23         I $$BASTAT^ORWDBA1=0 Q  ;CIDC (nee BA) not used
    24         ; If ORIFN not defined (God only knows why) then log error and quit
    25         I '$D(ORIFN) S MSG="ORIFN not defined" D VAR,EN^ORERR(MSG,"",.VAR) Q
    26         ;
    27         N ANCILARY,DXN,MSG,ORDX,ORITEM,ORSCEI,PTIEN,RT,SUCCESS,TAGROU,TFO,VAR
    28         ;
    29         S DXN=0,(RT,SUCCESS)="",PTIEN=+$P($G(^OR(100,ORIFN,0)),U,2)
    30         ; Package (ancillary) reference data
    31         S ORITEM=$G(^OR(100,ORIFN,4))
    32         ; Create an array (ORDX) of diagnoses
    33         F  S DXN=$O(^OR(100,ORIFN,5.1,DXN)) Q:'DXN  D
    34         . S ORDX(DXN)=$G(^OR(100,ORIFN,5.1,DXN,0))
    35         ; Treatment Factors - converted and reformatted
    36         S ORSCEI=$$TFGBLTBL($G(^OR(100,ORIFN,5.2)))
    37         ; Get the acronym of the package generating this order
    38         S ANCILARY=$P($G(^DIC(9.4,$P($G(^OR(100,ORIFN,0)),U,14),0)),U,2)
    39         ; Send data to the appropriate ancillary API based on package
    40         D OUTPUT
    41         ; If ancillary routine or tag w/in the routine doesn't exist check
    42         I 'RT D
    43         . S MSG="NON-EXISTANT ROUTINE/TAG FOR "_ANCILARY
    44         . D VAR,EN^ORERR(MSG,"",.VAR)
    45         ; If we don't get back a thumbs-up from the ancillary re: the order data
    46         I 'SUCCESS,RT D
    47         . S MSG="ANCILLARY API RETURNED ERROR FOR CPRS EDITED BACK DOOR DATA"
    48         . D VAR,EN^ORERR(MSG,"",.VAR)
    49         Q
    50         ;
    51 OUTPUT  ; Call ancillary's API to store data after checking for it's existence
    52         ;
    53         ; Laboratory
    54         I ANCILARY?1"LR".U D  Q
    55         . S RT=$$CKROUTAG("UPDOR^LRBEBA4") Q:'RT
    56         . S SUCCESS=$$UPDOR^LRBEBA4(PTIEN,ORITEM,ORIFN,.ORDX,ORSCEI)  ;IA 4775
    57         ;
    58         ; Pharmacy
    59         I ANCILARY?1"PS".U D  Q
    60         . S RT=$$CKROUTAG("EN^PSOHLNE3") Q:'RT
    61         . S SUCCESS=$$EN^PSOHLNE3(PTIEN,ORITEM,ORIFN,.ORDX,ORSCEI)  ;IA 4666
    62         ;
    63         ; Radiolgy
    64         I ANCILARY?1"RA".U D  Q
    65         . S RT=$$CKROUTAG("CPRSUPD^RABWORD1") Q:'RT
    66         . S SUCCESS=$$CPRSUPD^RABWORD1(PTIEN,ORITEM,ORIFN,.ORDX,ORSCEI) ;IA 4771
    67         Q
    68         ;
    69 CKROUTAG(TAGROU)        ;Check if valid tag and routine
    70         ; Temporary check until all the ancillaries have their API's built
    71         Q $L($T(@TAGROU))
    72         ;
    73 TFGBLTBL(GBL)   ;Convert Tx Factors from Global to TBL (HL7) order & format
    74         ; Note: this does not set Tx Factors in ZCL segment format but rather
    75         ;       AO^IR^SC^EC^MST^HNC^CV^SHD ('^' delimited string) format
    76         ;
    77         ; Input:  GBL in 1^1^0^0^^^0^ (global) format
    78         ; Output: TBL in 0^0^1^^1^^0^ (TBL) format (also reordered)
    79         ;
    80         N J,NTF,TBL,TF,TFGBL,TFGUI,TFTBL
    81         S TBL="",NTF=8  ;NCI=# of TxF
    82         ; Get Treatment Factor sequence order strings
    83         D TFSTGS^ORWDBA1
    84         ; Convert from GBL to TBL format and sequence
    85         F J=1:1:NTF S TF=$P(GBL,U,J) D
    86         . ;OK..just in case there is a '?' we'll return a null for a '?'
    87         . S TF($P(TFGBL,U,J))=$S(TF=1:1,TF=0:0,TF="?":"",1:"")
    88         F J=1:1:NTF S TBL=TBL_U_TF($P(TFTBL,U,J))
    89         ; Remove the first '^' and pass TBL formatted TF's
    90         Q $E(TBL,2,99)
    91         ;
    92 VAR     ;Create VAR array for tracking error in ^ORYX("ORERR",err#)
    93         S VAR("DFN")=PTIEN
    94         S VAR("ORITEM")=ORITEM
    95         S VAR("ORIFN")=ORIFN
    96         M VAR("ORDX")=ORDX
    97         S VAR("ORSCEI")=ORSCEI
    98         Q
    99         ;
    100 ISWITCH(Y,DFN)  ;Return 0 if don't ask (no ins) or 1 to ask CIDC quest (yes ins)
    101         S Y=$$CIDC^IBBAPI(DFN)
    102         Q
    103         ;
    104 GETIEN9(Y,ICD9) ;Return IEN for an ICD9 code (RPC: ORWDBA7 GETIEN9)
    105         S Y=$P($$CODEN^ICDCODE(ICD9,80),"~")
    106         Q
    107         ;
    108 CONDTLD ;Consult Detailed Display Compile for CIDC/BA (called by GMRCSLM2)
    109         ; Input:  ORIFN and GMRCCT defined in GMRCSLM2
    110         ; Output: CIDCARY = array of CIDC display lines for GMRCSLM2 display
    111         N BGNRCCT,DXIEN,DXOF,DXV,EYE,ICD9,ICDR,LINE,OCT,ORFMDAT,TF
    112         S BGNRCCT=GMRCCT,OCT=0
    113         ; Get the date of the order for CSV/CTD usage
    114         S ORFMDAT=$$ORFMDAT^ORWDBA3(ORIFN)
    115         ; $O through diagnoses for an order
    116         F  S OCT=$O(^OR(100,ORIFN,5.1,OCT)) Q:OCT'?1N.N  D
    117         . S DXOF="               "
    118         . ; DXIEN=Dx IEN
    119         . S DXIEN=+^OR(100,ORIFN,5.1,OCT,0)
    120         . ; Get Dx record for date ORFMDAT
    121         . S ICDR=$$ICDDX^ICDCODE(DXIEN,ORFMDAT)
    122         . ; Get Dx verbiage and ICD code
    123         . S DXV=$P(ICDR,U,4),ICD9=$P(ICDR,U,2)
    124         . I OCT=1 D
    125         .. S CIDCARY(GMRCCT,0)=" ",GMRCCT=GMRCCT+1 ;blank line
    126         .. S CIDCARY(GMRCCT,0)="Clinical Indicators",GMRCCT=GMRCCT+1
    127         .. S DXOF="Diagnosis of:  "
    128         . S LINE=DXOF_ICD9_" - "_DXV
    129         . S CIDCARY(GMRCCT,0)=LINE,GMRCCT=GMRCCT+1
    130         I OCT'="" D  ;if there are diagnoses then show Treatment Factors
    131         . S LINE="For conditions related to:    "
    132         . F EYE=1:1:8 S TF=$P(^OR(100,ORIFN,5.2),U,EYE) I TF D
    133         .. S CIDCARY(GMRCCT,0)=LINE_$$SC^ORQ21(EYE)
    134         .. S X=$$REPEAT^XLFSTR(" ",30),GMRCCT=GMRCCT+1
    135         Q
     1ORWDBA7 ;;SLC/GSS Billing Awareness (CIDC-Clinical Indicators Data Capture)
     2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**195,215**;Dec 17, 1997
     3 ;
     4BDOEDIT ; Backdoor entered orders edit in CPRS - entry point
     5 ; Data Flow> Ancillary creates a back door order which is incomplete
     6 ;            and thus edited in CPRS GUI. The ancillary needs to know
     7 ;            what Dx and TF's are edited thus this tag calls three
     8 ;            ancillary APIs, passing the Dx and TF data to them.
     9 ;
     10 ; Variable  Description
     11 ; ANCILARY  Acronym of ancillary/package relative to order
     12 ; DXN       Diagnosis sequence number in ^OR file
     13 ; MSG       Error message
     14 ; ORDX      Array of diagnoses (1-n) with value from ICD file (#80)
     15 ; ORIFN     Order internal reference number (defined in ORCSEND)
     16 ; ORITEM    Package reference or ^OR(100,ORIFN,4)
     17 ; ORSCEI    String of Treatment Factors in table SD008 order/format
     18 ; PTIEN     Patient IEN
     19 ; TAGROU    Tag^Routine of ancillary routine to store edited data
     20 ; TFO       Treatment Factors in ^OR (GBL) order
     21 ;
     22 ; If CIDC master switch set, then no back door orders to store
     23 I $$BASTAT^ORWDBA1=0 Q  ;CIDC (nee BA) not used
     24 ; If ORIFN not defined (God only knows why) then log error and quit
     25 I '$D(ORIFN) S MSG="ORIFN not defined" D VAR,EN^ORERR(MSG,"",.VAR) Q
     26 ;
     27 N ANCILARY,DXN,MSG,ORDX,ORITEM,ORSCEI,PTIEN,RT,SUCCESS,TAGROU,TFO,VAR
     28 ;
     29 S DXN=0,(RT,SUCCESS)="",PTIEN=+$P($G(^OR(100,ORIFN,0)),U,2)
     30 ; Package (ancillary) reference data
     31 S ORITEM=$G(^OR(100,ORIFN,4))
     32 ; Create an array (ORDX) of diagnoses
     33 F  S DXN=$O(^OR(100,ORIFN,5.1,DXN)) Q:'DXN  D
     34 . S ORDX(DXN)=$G(^OR(100,ORIFN,5.1,DXN,0))
     35 ; Treatment Factors - converted and reformatted
     36 S ORSCEI=$$TFGBLTBL($G(^OR(100,ORIFN,5.2)))
     37 ; Get the acronym of the package generating this order
     38 S ANCILARY=$P($G(^DIC(9.4,$P($G(^OR(100,ORIFN,0)),U,14),0)),U,2)  ;D???
     39 ; Send data to the appropriate ancillary API based on package
     40 D OUTPUT
     41 ; If ancillary routine or tag w/in the routine doesn't exist check
     42 I 'RT D
     43 . S MSG="NON-EXISTANT ROUTINE/TAG FOR "_ANCILARY
     44 . D VAR,EN^ORERR(MSG,"",.VAR)
     45 ; If we don't get back a thumbs-up from the ancillary re: the order data
     46 I 'SUCCESS,RT D
     47 . S MSG="ANCILLARY API RETURNED ERROR FOR CPRS EDITED BACK DOOR DATA"
     48 . D VAR,EN^ORERR(MSG,"",.VAR)
     49 Q
     50 ;
     51OUTPUT ; Call ancillary's API to store data after checking for it's existence
     52 ;
     53 ; Laboratory
     54 I ANCILARY?1"LR".U D  Q
     55 . S RT=$$CKROUTAG("UPDOR^LRBEBA4") Q:'RT
     56 . S SUCCESS=$$UPDOR^LRBEBA4(PTIEN,ORITEM,ORIFN,.ORDX,ORSCEI)  ;IA 4775
     57 ;
     58 ; Pharmacy
     59 I ANCILARY?1"PS".U D  Q
     60 . S RT=$$CKROUTAG("EN^PSOHLNE3") Q:'RT
     61 . S SUCCESS=$$EN^PSOHLNE3(PTIEN,ORITEM,ORIFN,.ORDX,ORSCEI)  ;IA 4666
     62 ;
     63 ; Radiolgy
     64 I ANCILARY?1"RA".U D  Q
     65 . S RT=$$CKROUTAG("CPRSUPD^RABWORD1") Q:'RT
     66 . S SUCCESS=$$CPRSUPD^RABWORD1(PTIEN,ORITEM,ORIFN,.ORDX,ORSCEI) ;IA 4771
     67 Q
     68 ;
     69CKROUTAG(TAGROU) ;Check if valid tag and routine
     70 ; Temporary check until all the ancillaries have their API's built
     71 Q $L($T(@TAGROU))
     72 ;
     73TFGBLTBL(GBL) ;Convert Tx Factors from Global to TBL (HL7) order & format
     74 ; Note: this does not set Tx Factors in ZCL segment format but rather
     75 ;       AO^IR^SC^EC^MST^HNC^CV ('^' delimited string) format
     76 ;
     77 ; Input:  GBL in 1^1^0^0^^^0 (global) format
     78 ; Output: TBL in 0^0^1^^1^^0 (TBL) format (also reordered)
     79 ;
     80 N J,NTF,TBL,TF,TFGBL,TFGUI,TFTBL
     81 S TBL="",NTF=7  ;NCI=# of TxF
     82 ; Get Treatment Factor sequence order strings
     83 D TFSTGS^ORWDBA1
     84 ; Convert from GBL to TBL format and sequence
     85 F J=1:1:NTF S TF=$P(GBL,U,J) D
     86 . ;OK..just in case there is a '?' we'll return a null for a '?'
     87 . S TF($P(TFGBL,U,J))=$S(TF=1:1,TF=0:0,TF="?":"",1:"")
     88 F J=1:1:NTF S TBL=TBL_U_TF($P(TFTBL,U,J))
     89 ; Remove the first '^' and pass TBL formatted TF's
     90 Q $E(TBL,2,99)
     91 ;
     92VAR ;Create VAR array for tracking error in ^ORYX("ORERR",err#)
     93 S VAR("DFN")=PTIEN
     94 S VAR("ORITEM")=ORITEM
     95 S VAR("ORIFN")=ORIFN
     96 M VAR("ORDX")=ORDX
     97 S VAR("ORSCEI")=ORSCEI
     98 Q
     99 ;
     100ISWITCH(Y,DFN) ;Return 0 if don't ask (no ins) or 1 to ask CIDC quest (yes ins)
     101 S Y=$$CIDC^IBBAPI(DFN)
     102 Q
     103 ;
     104GETIEN9(Y,ICD9) ;Return IEN for an ICD9 code (RPC: ORWDBA7 GETIEN9)
     105 S Y=$P($$CODEN^ICDCODE(ICD9,80),"~")
     106 Q
     107 ;
     108CONDTLD ;Consult Detailed Display Compile for CIDC/BA (called by GMRCSLM2)
     109 ; Input:  ORIFN and GMRCCT defined in GMRCSLM2
     110 ; Output: CIDCARY = array of CIDC display lines for GMRCSLM2 display
     111 N BGNRCCT,DXIEN,DXOF,DXV,EYE,ICD9,ICDR,LINE,OCT,ORFMDAT,TF
     112 S BGNRCCT=GMRCCT,OCT=0
     113 ; Get the date of the order for CSV/CTD usage
     114 S ORFMDAT=$$ORFMDAT^ORWDBA3(ORIFN)
     115 ; $O through diagnoses for an order
     116 F  S OCT=$O(^OR(100,ORIFN,5.1,OCT)) Q:OCT'?1N.N  D
     117 . S DXOF="               "
     118 . ; DXIEN=Dx IEN
     119 . S DXIEN=+^OR(100,ORIFN,5.1,OCT,0)
     120 . ; Get Dx record for date ORFMDAT
     121 . S ICDR=$$ICDDX^ICDCODE(DXIEN,ORFMDAT)
     122 . ; Get Dx verbiage and ICD code
     123 . S DXV=$P(ICDR,U,4),ICD9=$P(ICDR,U,2)
     124 . I OCT=1 D
     125 .. S CIDCARY(GMRCCT,0)=" ",GMRCCT=GMRCCT+1 ;blank line
     126 .. S CIDCARY(GMRCCT,0)="Clinical Indicators",GMRCCT=GMRCCT+1
     127 .. S DXOF="Diagnosis of:  "
     128 . S LINE=DXOF_ICD9_" - "_DXV
     129 . S CIDCARY(GMRCCT,0)=LINE,GMRCCT=GMRCCT+1
     130 I OCT'="" D  ;if there are diagnoses then show Treatment Factors
     131 . S LINE="For conditions related to:    "
     132 . F EYE=1:1:7 S TF=$P(^OR(100,ORIFN,5.2),U,EYE) I TF D
     133 .. S CIDCARY(GMRCCT,0)=LINE_$$SC^ORQ21(EYE)
     134 .. S X=$$REPEAT^XLFSTR(" ",30),GMRCCT=GMRCCT+1
     135 Q
Note: See TracChangeset for help on using the changeset viewer.