- ORWDBA3 ; SLC/GSS Billing Awareness (CIDC) [8/20/03 9:19am] ;05/23/12 10:36
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**190,195,243,361**;Dec 17, 1997;Build 39
- ;
- ORFMDAT(ORDFN) ; Return date in FM format regarding order for CSV/CTD/HIPAA
- ; Pass in Order IEN
- Q ($P($G(^OR(100,ORDFN,8,1,0)),"^",16)\1)
- ;
- DISPLAY ; Display of BA data from original copied order (ORIT = ORIEN)
- ; Displayed in window with all order info and user can accept/edit
- ; Note: TxF = Treatment Factor
- ; BA data (Dx,TxF's) not editable but in signature window, not in above
- ; ORIT defined in ORWDXM1, DISPLAY called from ORWDXM2
- ;
- ; Input:
- ; ORIT, ILST, and LST() from ORWDXM* routines
- ; Output:
- ; ILST and LST() appropriately incremented/populated for order display
- ; Variables:
- ; CUN = TxF's in C, U, or N format
- ; I = counter
- ; ILST = line counter, initially from ORWDXM* routines
- ; LST() = array of lines to output, initially from ORWDXM* routines
- ; NTF = # of Treatment Factors
- ; ORITARY = ORIT array of 1 needed to access GETTFCI^ORWDBA4
- ; SPCS = # of characters to space to left of ':'
- ; TF1 = first TxF output? (0/1)
- ; TFGBL = TxF's in Global stored order
- ; TFGUI = TxF's in GUI returned order
- ; TFV = TxF verbiage
- ;
- N CUN,I,NTF,ORITARY,SPCS,TF1,TFGBL,TFGUI,TFV,Y
- S NTF=8,SPCS=28,ORITARY(1)=+ORIT
- ; Get Y(+ORIT) string in ORIEN^CUUUCCN^Dx1^Desc1^Dx2^Desc2^... format
- D GETTFCI^ORWDBA4(.Y,.ORITARY)
- S CUN=$P($G(Y(1)),U,2) ;CUN = Treatment Factors in CUN syntax
- ; First output Diagnosis information - if any
- F I=3:2:9 I $P($G(Y(1)),U,I)'="" D
- . S ILST=ILST+1,LST(ILST)=$S(I=3:"Diagnoses",1:"")
- . S LST(ILST)=LST(ILST)_":"_$P(Y(1),U,I)_" - "_$P(Y(1),U,I+1)
- . D FRMTLST
- ; Get GUI and GBL Treatment Factor sequence strings
- D TFSTGS^ORWDBA1
- ; Assumes SC will always be first in sequence! - not likely to change
- S ILST=ILST+1
- S LST(ILST)="Service Connected:"_$S($E(CUN)="C":"YES",1:"NO")
- D FRMTLST
- S ILST=ILST+1,LST(ILST)="Treatment Factors:"
- ; If no TxF's (no 'C'hecked) {SC output above} then output '<none>'
- I '$F($E(CUN,2,NTF),"C") S LST(ILST)=LST(ILST)_"<none>" D FRMTLST Q
- S TF1=0 ;No TxF yet output
- ; Verbiage for TxF's
- S TFV("MST")="MILITARY SEXUAL TRAUMA",TFV("AO")="AGENT ORANGE"
- S TFV("IR")="IONIZING RADIATION",TFV("EC")="ENVIRONMENTAL CONTAMINANTS"
- S TFV("HNC")="HEAD AND NECK CANCER",TFV("CV")="COMBAT VETERAN"
- S TFV("SHD")="SHIPBOARD HAZARD"
- ; Output Checked TxF's
- F I=2:1:NTF I $E(CUN,I)="C" D
- . I 'TF1 S LST(ILST)=LST(ILST)_TFV($P(TFGUI,U,I)),TF1=1 D FRMTLST Q
- . S ILST=ILST+1,LST(ILST)=":"_TFV($P(TFGUI,U,I)) D FRMTLST
- Q
- ;
- FRMTLST ; Format the variable LST(ILST) for DISPLAY tag
- S LST(ILST)=$J($P(LST(ILST),":"),SPCS)_": "_$P(LST(ILST),":",2)
- Q
- ;
- HINTS(Y) ; Return HINTS for ORBA Treatment Factors - used by Delphi
- ; The hints returned in the Y array will be used in the CPRS GUI and
- ; displayed on fly-over of the cursor over the TxF text in the window
- ;
- ; Input
- ; <none>
- ; Output
- ; Y array of the hints for TxF's> Y(#)=TxFA ^ TxF line # ^ hint text
- ; where TxFA is Treatment Factor acronym, e.g., CV=Combat Veteran
- ; Variables
- ; CT = line number count, used in Y(#) where #=CT
- ; I = incrementor index #
- ; ORTFIEN = the IEN for the TxF in the Help Frame (^DIC(9.2)) file
- ; TF = TxF acronym
- ; TFLN = TxF text line number, e.g., ^DIC(9.2,ORTFIEN,1,TFLN,0)
- ; TFS = string of TxF acronyms
- ; TFV = TxF description/text
- ;
- N CT,I,ORTFIEN,TF,TFLN,TFS,TFV
- ;
- S TFS="SC^MST^AO^IR^EC^HNC^CV^SHD",CT=0
- ; Get next TxF from TFS
- F I=1:1 S TF=$P(TFS,U,I) Q:TF="" D
- . S ORTFIEN=$O(^DIC(9.2,"B","ORBA-"_TF,"")),TFV="",TFLN=0
- . ; Get next line of hint text
- . F S TFLN=$O(^DIC(9.2,ORTFIEN,1,TFLN)) Q:'TFLN D
- .. S CT=CT+1,Y(CT)=TF_U_TFLN_U_^DIC(9.2,ORTFIEN,1,TFLN,0)
- Q
- ;
- DG1(ORDFN,COUNTER,CTVALUE) ; Create DG1 segment(s) & make call for ZCL seg.
- ;
- ; Input
- ; ORDFN Internal Order ID#
- ; COUNTER Variable used as counter from calling routine
- ; CTVALUE Value of COUNTER when DG1 called
- ; Output
- ; DG1 & ZCL HL7 segments
- ;
- I $$BASTAT^ORWDBA1=0 Q ;BA not used
- N DG13,DXIEN,DXR,DXV,FROMFILE,ICD9,OCT,OREC,ORFMDAT
- ; zero order count variable
- S OCT=0
- ; Get the date of order (for CSV/CTD usage)
- S ORFMDAT=$$ORFMDAT(ORDFN)
- ; Get the diagnoses for an order
- F S OCT=$O(^OR(100,ORDFN,5.1,OCT)) Q:OCT'?1N.N D
- . S OREC=^OR(100,ORDFN,5.1,OCT,0)
- . S DXIEN=$P(OREC,U) ; DXIEN=pointer to diagnosis (ICD9) file #80
- . ; the DXIEN pointer should point to a valid diagnosis (after all is
- . ; was previously entered .. but just in case ...)
- . S (DXV,ICD9)=""
- . I DXIEN'="" D
- .. S DXR=$$ICDDATA^ICDXCODE("DIAGNOSIS",DXIEN,ORFMDAT) Q:+DXR=-1
- .. ; Get diagnosis verbiage and ICD code
- .. S DXV=$P(DXR,U,4),ICD9=$P(DXR,U,2)
- . S FROMFILE=80
- . S DG13=DXIEN_U_DXV_U_FROMFILE_U_ICD9_U_DXV_U_"ICD9"
- . S CTVALUE=CTVALUE+1
- . S ORMSG(CTVALUE)="DG1"_"|"_OCT_"||"_DG13_"|||||||||||||"
- . D ZCL
- S @COUNTER=CTVALUE
- Q
- ;
- ZCL ;create all the ZCL segments (currently 8 TxF's) for order number OCT
- ;
- N I,J,TABLE,TF,TFGBL,TFGUI,TFTBL,TFIN,TFS,VALUE
- D TFSTGS^ORWDBA1 ;set string sequence of treatment factors
- ; TFS is TxF data in ^OR(100,ORIEN,5.2) order
- S TFS=$G(^OR(100,ORDFN,5.2)),TABLE=""
- ; conversion order from ^OR stored data and Table SD008 for HL7 msg
- ; convert so that the ZCL segments will be in Table SD008 order (1-8)
- 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
- F TFIN=1:1:8 D
- . ; ORMSG counter incremented
- . S CTVALUE=CTVALUE+1
- . ; TF VALUE=0 for no or 1 for yes (only if not req. is it null)
- . S VALUE=$P(TFS,U,$E(TABLE,TFIN))
- . I VALUE="?" S VALUE=0 ;temp fix if sending '?' to ancillary???
- . ; for Table SD008: OCT=Set ID, SCIN=O/P Classif. Type, VALUE=Value
- . S ORMSG(CTVALUE)="ZCL|"_OCT_"|"_TFIN_"|"_VALUE
- Q
- ;
- BDOSTR ;Store backdoor order DG1 and ZCL messages from HL7
- ;Processes one order per entry into BDOSTR, e.g., ROUT(1)
- ;Depends upon ORM* routines to set-up a number of variables including
- ; ORMSG array and ORIFN.
- ;ORM* routines calling BDOSTR: ORMGMRC, ORMLR, ORMPS, & ORMRA
- ;
- ; Input: HL7 messages and related data
- ; Output: ROUT array in Delphi GUI format, i.e.
- ; OrderIEN;11CNNNCNN^exDx1^exDx2^exDx3^exDx4
- ;
- ; Variables Used
- ; DG1 = sequential numbered array with a value of DXIEN
- ; I,J = counters
- ; GUITF = GUI order treatment factors (TxF)
- ; NDX = number of diagnoses being passed
- ; NTF = number of TxF
- ; OBX = @ORMSG Dx array element # (max of 4 diagnoses stored)
- ; REC = set to sequential HL7 messages, contains HL7 message data
- ; ROUT = record sent for storage processing to RCVORCI
- ; TF = individual TxF values
- ; TFGBL = TxF acronyms in ^ delimited string in ^OR sequence
- ; TFGUI = TxF acronyms in ^ delimited string in from GUI sequence
- ; TFTBL = TxF acronyms in ^ delimited string in Table SD008 sequence
- ; VAL = individual TxF values
- ; ZCL = TxF in Table SD008 format and sequence
- ;
- ; See if CIDC master switch set, if not then no DG1/ZCL seg, to store
- I $$BASTAT^ORWDBA1=0 Q ;CIDC (nee BA) not used
- ;
- N CPNODE,CT,DG1,I,J,GUITF,NDX,NTF,OBX,REC,ROUT,ORSDCARY,SDCARYA
- N TF,TFGBL,TFGUI,TFTBL,VAL,X,ZCL
- ;
- K ORSDCARY,SDCARYA
- D TFSTGS^ORWDBA1 ;set string sequence of treatment factors
- S (CT,NDX,OBX)=0,NTF=8,(CPNODE,GUITF,TF,Y,ZCL)="",X="T"
- ; Call API to acquire Treatment Factors in force
- D NOW^%DTC,CL^SDCO21(DFN,%,"",.ORSDCARY) ;DBIA 406
- ; Retrved array order: AO,IR,SC,EC,MST,HNC,CV,SHD, e.g., ORSDCARY(3) for SC
- ; Convert to character array, e.g., SDCARYA("SC")=""
- F I=1:1:NTF S:$D(ORSDCARY(I)) SDCARYA($P("AO^IR^SC^EC^MST^HNC^CV^SHD",U,I))=""
- ; Process only four DG1 segments and first set of ZCL segments
- 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
- . S REC=@ORMSG@(OBX)
- . ; Setting DG1(#)=DXIEN where # is Dx sequence # (1=primary)
- . I J="DG1"&(NDX<4) S DG1($P(REC,"|",2))=$P(REC,U,4),NDX=NDX+1 Q
- . ; Create ZCL string of TxFs, e.g., 1101011
- . I J="ZCL" D
- .. S:$P(REC,"|",4)="" $P(REC,"|",4)=" "
- .. S $E(ZCL,$P(REC,"|",3))=$P(REC,"|",4)
- ; convert order and format from Table SD008 to GUI
- F I=1:1:NTF S TF=$P(TFGUI,U,I) F J=1:1:NTF I $P(TFTBL,U,J)=TF D
- . ; If patient does not have that Tx Factor (TF) then ghost in GUI ("N")
- . I '$D(SDCARYA(TF)) S GUITF=GUITF_"N" Q
- . ; If patient has TF then format for GUI (C=ck'd, U=unck'd, ?=not ans)
- . S VAL=$E(ZCL,J),GUITF=GUITF_$S(VAL=1:"C",VAL=0:"U",1:"?")
- ; Create output string in a format that can be stored by RCVORCI^ORWDBA1
- S ROUT(1)=ORIFN_";11"_GUITF_U_$G(DG1(1))_U_$G(DG1(2))_U_$G(DG1(3))_U_$G(DG1(4))
- ; Store diagnoses and treatment factors
- D RCVORCI^ORWDBA1(Y,.ROUT)
- Q
- ;
- ERRMSG(VISIT) ; Error handling and message
- ; to be determined
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWDBA3 9068 printed Jan 18, 2025@03:36:29 Page 2
- ORWDBA3 ; SLC/GSS Billing Awareness (CIDC) [8/20/03 9:19am] ;05/23/12 10:36
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**190,195,243,361**;Dec 17, 1997;Build 39
- +2 ;
- ORFMDAT(ORDFN) ; Return date in FM format regarding order for CSV/CTD/HIPAA
- +1 ; Pass in Order IEN
- +2 QUIT ($PIECE($GET(^OR(100,ORDFN,8,1,0)),"^",16)\1)
- +3 ;
- DISPLAY ; Display of BA data from original copied order (ORIT = ORIEN)
- +1 ; Displayed in window with all order info and user can accept/edit
- +2 ; Note: TxF = Treatment Factor
- +3 ; BA data (Dx,TxF's) not editable but in signature window, not in above
- +4 ; ORIT defined in ORWDXM1, DISPLAY called from ORWDXM2
- +5 ;
- +6 ; Input:
- +7 ; ORIT, ILST, and LST() from ORWDXM* routines
- +8 ; Output:
- +9 ; ILST and LST() appropriately incremented/populated for order display
- +10 ; Variables:
- +11 ; CUN = TxF's in C, U, or N format
- +12 ; I = counter
- +13 ; ILST = line counter, initially from ORWDXM* routines
- +14 ; LST() = array of lines to output, initially from ORWDXM* routines
- +15 ; NTF = # of Treatment Factors
- +16 ; ORITARY = ORIT array of 1 needed to access GETTFCI^ORWDBA4
- +17 ; SPCS = # of characters to space to left of ':'
- +18 ; TF1 = first TxF output? (0/1)
- +19 ; TFGBL = TxF's in Global stored order
- +20 ; TFGUI = TxF's in GUI returned order
- +21 ; TFV = TxF verbiage
- +22 ;
- +23 NEW CUN,I,NTF,ORITARY,SPCS,TF1,TFGBL,TFGUI,TFV,Y
- +24 SET NTF=8
- SET SPCS=28
- SET ORITARY(1)=+ORIT
- +25 ; Get Y(+ORIT) string in ORIEN^CUUUCCN^Dx1^Desc1^Dx2^Desc2^... format
- +26 DO GETTFCI^ORWDBA4(.Y,.ORITARY)
- +27 ;CUN = Treatment Factors in CUN syntax
- SET CUN=$PIECE($GET(Y(1)),U,2)
- +28 ; First output Diagnosis information - if any
- +29 FOR I=3:2:9
- IF $PIECE($GET(Y(1)),U,I)'=""
- Begin DoDot:1
- +30 SET ILST=ILST+1
- SET LST(ILST)=$SELECT(I=3:"Diagnoses",1:"")
- +31 SET LST(ILST)=LST(ILST)_":"_$PIECE(Y(1),U,I)_" - "_$PIECE(Y(1),U,I+1)
- +32 DO FRMTLST
- End DoDot:1
- +33 ; Get GUI and GBL Treatment Factor sequence strings
- +34 DO TFSTGS^ORWDBA1
- +35 ; Assumes SC will always be first in sequence! - not likely to change
- +36 SET ILST=ILST+1
- +37 SET LST(ILST)="Service Connected:"_$SELECT($EXTRACT(CUN)="C":"YES",1:"NO")
- +38 DO FRMTLST
- +39 SET ILST=ILST+1
- SET LST(ILST)="Treatment Factors:"
- +40 ; If no TxF's (no 'C'hecked) {SC output above} then output '<none>'
- +41 IF '$FIND($EXTRACT(CUN,2,NTF),"C")
- SET LST(ILST)=LST(ILST)_"<none>"
- DO FRMTLST
- QUIT
- +42 ;No TxF yet output
- SET TF1=0
- +43 ; Verbiage for TxF's
- +44 SET TFV("MST")="MILITARY SEXUAL TRAUMA"
- SET TFV("AO")="AGENT ORANGE"
- +45 SET TFV("IR")="IONIZING RADIATION"
- SET TFV("EC")="ENVIRONMENTAL CONTAMINANTS"
- +46 SET TFV("HNC")="HEAD AND NECK CANCER"
- SET TFV("CV")="COMBAT VETERAN"
- +47 SET TFV("SHD")="SHIPBOARD HAZARD"
- +48 ; Output Checked TxF's
- +49 FOR I=2:1:NTF
- IF $EXTRACT(CUN,I)="C"
- Begin DoDot:1
- +50 IF 'TF1
- SET LST(ILST)=LST(ILST)_TFV($PIECE(TFGUI,U,I))
- SET TF1=1
- DO FRMTLST
- QUIT
- +51 SET ILST=ILST+1
- SET LST(ILST)=":"_TFV($PIECE(TFGUI,U,I))
- DO FRMTLST
- End DoDot:1
- +52 QUIT
- +53 ;
- FRMTLST ; Format the variable LST(ILST) for DISPLAY tag
- +1 SET LST(ILST)=$JUSTIFY($PIECE(LST(ILST),":"),SPCS)_": "_$PIECE(LST(ILST),":",2)
- +2 QUIT
- +3 ;
- HINTS(Y) ; Return HINTS for ORBA Treatment Factors - used by Delphi
- +1 ; The hints returned in the Y array will be used in the CPRS GUI and
- +2 ; displayed on fly-over of the cursor over the TxF text in the window
- +3 ;
- +4 ; Input
- +5 ; <none>
- +6 ; Output
- +7 ; Y array of the hints for TxF's> Y(#)=TxFA ^ TxF line # ^ hint text
- +8 ; where TxFA is Treatment Factor acronym, e.g., CV=Combat Veteran
- +9 ; Variables
- +10 ; CT = line number count, used in Y(#) where #=CT
- +11 ; I = incrementor index #
- +12 ; ORTFIEN = the IEN for the TxF in the Help Frame (^DIC(9.2)) file
- +13 ; TF = TxF acronym
- +14 ; TFLN = TxF text line number, e.g., ^DIC(9.2,ORTFIEN,1,TFLN,0)
- +15 ; TFS = string of TxF acronyms
- +16 ; TFV = TxF description/text
- +17 ;
- +18 NEW CT,I,ORTFIEN,TF,TFLN,TFS,TFV
- +19 ;
- +20 SET TFS="SC^MST^AO^IR^EC^HNC^CV^SHD"
- SET CT=0
- +21 ; Get next TxF from TFS
- +22 FOR I=1:1
- SET TF=$PIECE(TFS,U,I)
- if TF=""
- QUIT
- Begin DoDot:1
- +23 SET ORTFIEN=$ORDER(^DIC(9.2,"B","ORBA-"_TF,""))
- SET TFV=""
- SET TFLN=0
- +24 ; Get next line of hint text
- +25 FOR
- SET TFLN=$ORDER(^DIC(9.2,ORTFIEN,1,TFLN))
- if 'TFLN
- QUIT
- Begin DoDot:2
- +26 SET CT=CT+1
- SET Y(CT)=TF_U_TFLN_U_^DIC(9.2,ORTFIEN,1,TFLN,0)
- End DoDot:2
- End DoDot:1
- +27 QUIT
- +28 ;
- DG1(ORDFN,COUNTER,CTVALUE) ; Create DG1 segment(s) & make call for ZCL seg.
- +1 ;
- +2 ; Input
- +3 ; ORDFN Internal Order ID#
- +4 ; COUNTER Variable used as counter from calling routine
- +5 ; CTVALUE Value of COUNTER when DG1 called
- +6 ; Output
- +7 ; DG1 & ZCL HL7 segments
- +8 ;
- +9 ;BA not used
- IF $$BASTAT^ORWDBA1=0
- QUIT
- +10 NEW DG13,DXIEN,DXR,DXV,FROMFILE,ICD9,OCT,OREC,ORFMDAT
- +11 ; zero order count variable
- +12 SET OCT=0
- +13 ; Get the date of order (for CSV/CTD usage)
- +14 SET ORFMDAT=$$ORFMDAT(ORDFN)
- +15 ; Get the diagnoses for an order
- +16 FOR
- SET OCT=$ORDER(^OR(100,ORDFN,5.1,OCT))
- if OCT'?1N.N
- QUIT
- Begin DoDot:1
- +17 SET OREC=^OR(100,ORDFN,5.1,OCT,0)
- +18 ; DXIEN=pointer to diagnosis (ICD9) file #80
- SET DXIEN=$PIECE(OREC,U)
- +19 ; the DXIEN pointer should point to a valid diagnosis (after all is
- +20 ; was previously entered .. but just in case ...)
- +21 SET (DXV,ICD9)=""
- +22 IF DXIEN'=""
- Begin DoDot:2
- +23 SET DXR=$$ICDDATA^ICDXCODE("DIAGNOSIS",DXIEN,ORFMDAT)
- if +DXR=-1
- QUIT
- +24 ; Get diagnosis verbiage and ICD code
- +25 SET DXV=$PIECE(DXR,U,4)
- SET ICD9=$PIECE(DXR,U,2)
- End DoDot:2
- +26 SET FROMFILE=80
- +27 SET DG13=DXIEN_U_DXV_U_FROMFILE_U_ICD9_U_DXV_U_"ICD9"
- +28 SET CTVALUE=CTVALUE+1
- +29 SET ORMSG(CTVALUE)="DG1"_"|"_OCT_"||"_DG13_"|||||||||||||"
- +30 DO ZCL
- End DoDot:1
- +31 SET @COUNTER=CTVALUE
- +32 QUIT
- +33 ;
- ZCL ;create all the ZCL segments (currently 8 TxF's) for order number OCT
- +1 ;
- +2 NEW I,J,TABLE,TF,TFGBL,TFGUI,TFTBL,TFIN,TFS,VALUE
- +3 ;set string sequence of treatment factors
- DO TFSTGS^ORWDBA1
- +4 ; TFS is TxF data in ^OR(100,ORIEN,5.2) order
- +5 SET TFS=$GET(^OR(100,ORDFN,5.2))
- SET TABLE=""
- +6 ; conversion order from ^OR stored data and Table SD008 for HL7 msg
- +7 ; convert so that the ZCL segments will be in Table SD008 order (1-8)
- +8 FOR I=1:1:8
- SET TF=$PIECE(TFTBL,U,I)
- FOR J=1:1:8
- IF $PIECE(TFGBL,U,J)=TF
- SET TABLE=TABLE_J
- QUIT
- +9 FOR TFIN=1:1:8
- Begin DoDot:1
- +10 ; ORMSG counter incremented
- +11 SET CTVALUE=CTVALUE+1
- +12 ; TF VALUE=0 for no or 1 for yes (only if not req. is it null)
- +13 SET VALUE=$PIECE(TFS,U,$EXTRACT(TABLE,TFIN))
- +14 ;temp fix if sending '?' to ancillary???
- IF VALUE="?"
- SET VALUE=0
- +15 ; for Table SD008: OCT=Set ID, SCIN=O/P Classif. Type, VALUE=Value
- +16 SET ORMSG(CTVALUE)="ZCL|"_OCT_"|"_TFIN_"|"_VALUE
- End DoDot:1
- +17 QUIT
- +18 ;
- BDOSTR ;Store backdoor order DG1 and ZCL messages from HL7
- +1 ;Processes one order per entry into BDOSTR, e.g., ROUT(1)
- +2 ;Depends upon ORM* routines to set-up a number of variables including
- +3 ; ORMSG array and ORIFN.
- +4 ;ORM* routines calling BDOSTR: ORMGMRC, ORMLR, ORMPS, & ORMRA
- +5 ;
- +6 ; Input: HL7 messages and related data
- +7 ; Output: ROUT array in Delphi GUI format, i.e.
- +8 ; OrderIEN;11CNNNCNN^exDx1^exDx2^exDx3^exDx4
- +9 ;
- +10 ; Variables Used
- +11 ; DG1 = sequential numbered array with a value of DXIEN
- +12 ; I,J = counters
- +13 ; GUITF = GUI order treatment factors (TxF)
- +14 ; NDX = number of diagnoses being passed
- +15 ; NTF = number of TxF
- +16 ; OBX = @ORMSG Dx array element # (max of 4 diagnoses stored)
- +17 ; REC = set to sequential HL7 messages, contains HL7 message data
- +18 ; ROUT = record sent for storage processing to RCVORCI
- +19 ; TF = individual TxF values
- +20 ; TFGBL = TxF acronyms in ^ delimited string in ^OR sequence
- +21 ; TFGUI = TxF acronyms in ^ delimited string in from GUI sequence
- +22 ; TFTBL = TxF acronyms in ^ delimited string in Table SD008 sequence
- +23 ; VAL = individual TxF values
- +24 ; ZCL = TxF in Table SD008 format and sequence
- +25 ;
- +26 ; See if CIDC master switch set, if not then no DG1/ZCL seg, to store
- +27 ;CIDC (nee BA) not used
- IF $$BASTAT^ORWDBA1=0
- QUIT
- +28 ;
- +29 NEW CPNODE,CT,DG1,I,J,GUITF,NDX,NTF,OBX,REC,ROUT,ORSDCARY,SDCARYA
- +30 NEW TF,TFGBL,TFGUI,TFTBL,VAL,X,ZCL
- +31 ;
- +32 KILL ORSDCARY,SDCARYA
- +33 ;set string sequence of treatment factors
- DO TFSTGS^ORWDBA1
- +34 SET (CT,NDX,OBX)=0
- SET NTF=8
- SET (CPNODE,GUITF,TF,Y,ZCL)=""
- SET X="T"
- +35 ; Call API to acquire Treatment Factors in force
- +36 ;DBIA 406
- DO NOW^%DTC
- DO CL^SDCO21(DFN,%,"",.ORSDCARY)
- +37 ; Retrved array order: AO,IR,SC,EC,MST,HNC,CV,SHD, e.g., ORSDCARY(3) for SC
- +38 ; Convert to character array, e.g., SDCARYA("SC")=""
- +39 FOR I=1:1:NTF
- if $DATA(ORSDCARY(I))
- SET SDCARYA($PIECE("AO^IR^SC^EC^MST^HNC^CV^SHD",U,I))=""
- +40 ; Process only four DG1 segments and first set of ZCL segments
- +41 FOR
- SET OBX=$ORDER(@ORMSG@(OBX))
- if OBX'>0
- QUIT
- SET J=$EXTRACT(@ORMSG@(OBX),1,3)
- IF J="DG1"!(J="ZCL"&($PIECE(@ORMSG@(OBX),"|",2)=1))
- Begin DoDot:1
- +42 SET REC=@ORMSG@(OBX)
- +43 ; Setting DG1(#)=DXIEN where # is Dx sequence # (1=primary)
- +44 IF J="DG1"&(NDX<4)
- SET DG1($PIECE(REC,"|",2))=$PIECE(REC,U,4)
- SET NDX=NDX+1
- QUIT
- +45 ; Create ZCL string of TxFs, e.g., 1101011
- +46 IF J="ZCL"
- Begin DoDot:2
- +47 if $PIECE(REC,"|",4)=""
- SET $PIECE(REC,"|",4)=" "
- +48 SET $EXTRACT(ZCL,$PIECE(REC,"|",3))=$PIECE(REC,"|",4)
- End DoDot:2
- End DoDot:1
- +49 ; convert order and format from Table SD008 to GUI
- +50 FOR I=1:1:NTF
- SET TF=$PIECE(TFGUI,U,I)
- FOR J=1:1:NTF
- IF $PIECE(TFTBL,U,J)=TF
- Begin DoDot:1
- +51 ; If patient does not have that Tx Factor (TF) then ghost in GUI ("N")
- +52 IF '$DATA(SDCARYA(TF))
- SET GUITF=GUITF_"N"
- QUIT
- +53 ; If patient has TF then format for GUI (C=ck'd, U=unck'd, ?=not ans)
- +54 SET VAL=$EXTRACT(ZCL,J)
- SET GUITF=GUITF_$SELECT(VAL=1:"C",VAL=0:"U",1:"?")
- End DoDot:1
- +55 ; Create output string in a format that can be stored by RCVORCI^ORWDBA1
- +56 SET ROUT(1)=ORIFN_";11"_GUITF_U_$GET(DG1(1))_U_$GET(DG1(2))_U_$GET(DG1(3))_U_$GET(DG1(4))
- +57 ; Store diagnoses and treatment factors
- +58 DO RCVORCI^ORWDBA1(Y,.ROUT)
- +59 QUIT
- +60 ;
- ERRMSG(VISIT) ; Error handling and message
- +1 ; to be determined
- +2 QUIT