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 Dec 13, 2024@02:35:20 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
