BDGPCCE1 ; IHS/ANMC/LJF - BUILD DISPLAY SCREENS FOR CODE ; [ 06/19/2002 11:37 AM ]
;;5.3;PIMS;**1008**;APR 26, 2002
;
;cmi/anch/maw 12/7/2007 PATCH 1008 added code set versioning ADMIT,OP
;
;6/19/2002 LJF8 next line added per Linda
S IORVON=$G(IORVON),IORVOFF=$G(IORVOFF),IOUON=$G(IOUON),IOUOFF=$G(IOUOFF) ;IHS/ANMC/LJF 6/18/2002 to prevent undef if device not set up completely
D ADMIT,POV,OP,PROV,OTHER Q
;
ADMIT ; build display of admit data
NEW LINE,VH
S VH=$O(^AUPNVINP("AD",BDGV,0)) I 'VH D Q
. D SET("** ERROR! Cannot find V Hospitalization Entry! **",.VALMCNT)
;
D SET(IORVON_"General Admission Data"_IORVOFF,.VALMCNT)
S LINE=$$PAD(IOUON_"Admission",42)_"Discharge"_IOUOFF
D SET(LINE,.VALMCNT)
;
S LINE=$$PAD($$GET1^DIQ(9000010,BDGV,.01),38)
S LINE=LINE_$$GET1^DIQ(9000010.02,VH,.01)
D SET(LINE,.VALMCNT) ;admit and disch dates
;
S LINE=$$PAD($$GET1^DIQ(9000010.02,VH,.04),38)
S LINE=LINE_$$GET1^DIQ(9000010.02,VH,.05)
D SET(LINE,.VALMCNT) ;admit and disch services
;
S LINE=$$GET1^DIQ(9000010.02,VH,.07)_" ("
S X=$$GET1^DIQ(9000010.02,VH,.07,"I")
S LINE=$$PAD(LINE_$$GET1^DIQ(405.1,X,9999999.1)_")",38)
S LINE=LINE_$$GET1^DIQ(9000010.02,VH,.06)_" ("
S X=$$GET1^DIQ(9000010.02,VH,.06,"I")
S LINE=LINE_$$GET1^DIQ(405.1,X,9999999.1)_")"
D SET(LINE,.VALMCNT) ;admit and disch types (IHS)
;
S LINE=$$GET1^DIQ(9000010.02,VH,6101)
I LINE]"" S LINE=LINE_" ("_$$GET1^DIQ(9000010.02,VH,6101,"I")_")"
S LINE=$$PAD(LINE,38)_$$GET1^DIQ(9000010.02,VH,.09)
D SET(LINE,.VALMCNT) ;admit type (ub92) & transfer facility
;
S LINE=$$GET1^DIQ(9000010.02,VH,6102)
I LINE]"" S LINE=LINE_" ("_$$GET1^DIQ(9000010.02,VH,6102,"I")_")"
S LINE=$$PAD(LINE,38)_$$GET1^DIQ(9000010.02,VH,6103)
S LINE=LINE_" ("_$$GET1^DIQ(9000010.02,VH,6103,"I")_")"
D SET(LINE,.VALMCNT) ;admit source & disch status (UB92 style)
;
S LINE="DX upon Admission: ",X=$O(^DGPM("AVISIT",BDGV,0))
I X S LINE=LINE_$$GET1^DIQ(405,X,.1)
D SET(LINE,.VALMCNT) ;free text admitting dx
;
S LINE=$$SP(5)_"Coded Adm DX: "_$$GET1^DIQ(9000010.02,VH,.12)
I $L(LINE)>10 S LINE=LINE_" - "
;S LINE=LINE_$$GET1^DIQ(80,+$$GET1^DIQ(9000010.02,VH,.12,"I"),3)
S LINE=LINE_$P($$ICDDX^ICDCODE(+$$GET1^DIQ(9000010.02,VH,.12,"I")),U,4)
D SET(LINE,.VALMCNT) ;admitting dx
;
S LINE=$$SP(14)_"DRG: "_$$GET1^DIQ(9000010,BDGV,.34)
I $L(LINE)>9 S LINE=LINE_" - "
S LINE=LINE_$G(^ICD(+$$GET1^DIQ(9000010,BDGV,.34,"I"),1,1,0))
D SET(LINE,.VALMCNT) ;visit DRG
;
S LINE=$$SP(7)_"# Consults: "_$$GET1^DIQ(9000010.02,VH,.08)
D SET(LINE,.VALMCNT)
D SET("",.VALMCNT) ;blank line between sections
Q
;
POV ; build diagnosis display
NEW IEN,LINE,X,Y
I '$D(^AUPNVPOV("AD",BDGV)) D Q
. D SET("** No Diagnoses Entered for Visit! **",.VALMCNT)
;
D SET("",.VALMCNT),SET(IORVON_"POV (Diagnoses)"_IORVOFF,.VALMCNT)
S IEN=0 F S IEN=$O(^AUPNVPOV("AD",BDGV,IEN)) Q:'IEN D
. S LINE=$$GET1^DIQ(9000010.07,IEN,.01)
. S LINE=$$PAD(LINE,8)_"("_$$GET1^DIQ(9000010.07,IEN,.12,"I")_") "
. S LINE=LINE_$$GET1^DIQ(9000010.07,IEN,.019)
. D SET(LINE,.VALMCNT) ;icd code, prim/sec and icd description
. ;
. D SET($$SP(12)_$$GET1^DIQ(9000010.07,IEN,.04),.VALMCNT) ;prov narr
. ;
. S X=$$GET1^DIQ(9000010.07,IEN,.06),Y=$$GET1^DIQ(9000010.07,IEN,.07)
. I (X]"")!(Y]"") D
.. D SET($$PAD($$SP(12)_"Modifier: "_X,38)_"Cause of DX: "_Y,.VALMCNT)
. ;
. S X=$$GET1^DIQ(9000010.07,IEN,.09) I X]"" D
.. S LINE=$$PAD($$SP(12)_"E-Code: "_X,38)_$$GET1^DIQ(9000010.07,IEN,.13)
.. D SET(LINE,.VALMCNT) ;e-code & date of injury
.. D SET($$SP(12)_"Place of Accident: "_$$GET1^DIQ(9000010.07,IEN,.11),.VALMCNT)
.. ;
.. D SET("",.VALMCNT) ;blank line between dx
Q
;
OP ; build list of procedures
NEW IEN,LINE,X,Y
I '$D(^AUPNVPRC("AD",BDGV)) Q ;no procedures
;
D SET("",.VALMCNT),SET(IORVON_"Procedures"_IORVOFF,.VALMCNT)
;
S IEN=0 F S IEN=$O(^AUPNVPRC("AD",BDGV,IEN)) Q:'IEN D
. S LINE=$$PAD($$GET1^DIQ(9000010.08,IEN,.01),10)
. S X=$$GET1^DIQ(9000010.08,IEN,.07) ;princ procedure?
. S LINE=$$PAD(LINE_$S(X="YES":" (P)",1:""),17)
. S LINE=LINE_$$GET1^DIQ(9000010.08,IEN,.019)
. D SET(LINE,.VALMCNT) ;icd code, princ?, icd description
. ;
. D SET($$SP(10)_$$GET1^DIQ(9000010.08,IEN,.04),.VALMCNT) ;prov narr
. ;
. S LINE=$$GET1^DIQ(9000010.08,IEN,.16)_$$GET1^DIQ(9000010.08,IEN,.17)
. S LINE=LINE_$$SP(3)_$$GET1^DIQ(9000010.08,IEN,.1609)
. S LINE=$$PAD("CPT: "_LINE,50)_"Infection? "
. S LINE=LINE_$$GET1^DIQ(9000010.08,IEN,.08)
. D SET(LINE,.VALMCNT) ;CPT codes & infection question
. ;
. S LINE="Date: "_$$GET1^DIQ(9000010.08,IEN,.06)
. S X=$$GET1^DIQ(9000010.08,IEN,.05)
. I X]"" D
.. S Y=$$GET1^DIQ(9000010.08,IEN,.05,"I")
.. ;S X=X_$$SP(3)_$$GET1^DIQ(80,Y,3)
.. S X=X_$$SP(3)_$P($$ICDDX^ICDCODE(Y),U,4)
. D SET($$PAD(LINE,30)_"Dx: "_X,.VALMCNT) ;date & dx
. ;
. S LINE="Operating: "_$$GET1^DIQ(9000010.08,IEN,.11)
. S X=$$GET1^DIQ(9000010.08,IEN,.12)
. I X]"" S LINE=$$PAD(LINE,38)_"Anesthesiologist: "_X
. D SET(LINE,.VALMCNT) ;providers-operating & anesthesia
. ;
. S X=$$GET1^DIQ(9000010.08,IEN,.14)
. I X="YES" D
.. S LINE="Elapsed Time (Anes): "_$$GET1^DIQ(9000010.08,IEN,.13)
.. S LINE=$$PAD(LINE,38)_"ASA-PS Class: "_$$GET1^DIQ(9000010.08,IEN,.15)
.. D SET(LINE,.VALMCNT) ;anesthesia data
. ;
. D SET("",.VALMCNT) ;blank line between procedures
Q
;
PROV ; build display of providers
NEW IEN,LINE,X,Y
I '$D(^AUPNVPRV("AD",BDGV)) D Q
. D SET("** No Providers Entered for Visit! **",.VALMCNT)
;
D SET("",.VALMCNT),SET(IORVON_"Providers"_IORVOFF,.VALMCNT)
S IEN=0 F S IEN=$O(^AUPNVPRV("AD",BDGV,IEN)) Q:'IEN D
. S LINE=$$PAD($$GET1^DIQ(9000010.06,IEN,.01),37) ;prov name
. S LINE=LINE_$$GET1^DIQ(9000010.06,IEN,.019) ;prov code
. S X=$$GET1^DIQ(9000010.06,IEN,.04) ;prim/sec
. S Y=$$GET1^DIQ(9000010.06,IEN,.05) ;atten/oper/cons
. S LINE=$$PAD(LINE,50)_X_$S(Y]"":"/"_Y,1:"")
. D SET(LINE,.VALMCNT),SET("",.VALMCNT)
Q
;
OTHER ; build display of all other PCC data for patient's visit
NEW FILE,GLOBAL,IEN,LINE,X,Y,NAME
S FILE=9000010
F S FILE=$O(^DIC(FILE)) Q:'FILE Q:(FILE>9000010.9999) D
. Q:FILE=9000010.02 Q:FILE=9000010.06 Q:FILE=9000010.07
. Q:FILE=9000010.08
. S GLOBAL=$G(^DIC(FILE,0,"GL")) Q:GLOBAL=""
. S GLOBAL=$P(GLOBAL,"(") ;strip off parens for indirection
. S NAME=$P($P(^DIC(FILE,0),U),"V ",2)
. ;
. I $D(@GLOBAL@("AD",BDGV)) D SET("",.VALMCNT),SET(IORVON_NAME_IORVOFF,.VALMCNT)
. ;
. S IEN=0 F S IEN=$O(@GLOBAL@("AD",BDGV,IEN)) Q:'IEN D
.. S LINE=$$GET1^DIQ(FILE,IEN,.01)
.. ;
.. ; do CPT file differently
.. I NAME="CPT" D Q
... S LINE=LINE_$$GET1^DIQ(FILE,IEN,.08)_$$SP(4)
... S X=$$GET1^DIQ(FILE,IEN,.16) ;quantity
... S LINE=LINE_"("_$S(X="":1,1:X)_") "
... S LINE=LINE_$$GET1^DIQ(FILE,IEN,.019) ;cpt short name
... D SET(LINE,.VALMCNT),SET("",.VALMCNT)
.. ;
.. S LINE=LINE_$$SP(3)_$$GET1^DIQ(FILE,IEN,.04)
.. D SET(LINE,.VALMCNT),SET("",.VALMCNT)
Q
;
SET(DATA,NUM) ; puts display data into array
S NUM=NUM+1
S ^TMP("BDGPCCE",$J,NUM,0)=DATA
Q
;
PAD(D,L) ;EP -- SUBRTN to pad length of data
; -- D=data L=length
Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
;
SP(N) ; -- SUBRTN to pad N number of spaces
Q $$PAD(" ",N)
BDGPCCE1 ; IHS/ANMC/LJF - BUILD DISPLAY SCREENS FOR CODE ; [ 06/19/2002 11:37 AM ]
+1 ;;5.3;PIMS;**1008**;APR 26, 2002
+2 ;
+3 ;cmi/anch/maw 12/7/2007 PATCH 1008 added code set versioning ADMIT,OP
+4 ;
+5 ;6/19/2002 LJF8 next line added per Linda
+6 ;IHS/ANMC/LJF 6/18/2002 to prevent undef if device not set up completely
SET IORVON=$GET(IORVON)
SET IORVOFF=$GET(IORVOFF)
SET IOUON=$GET(IOUON)
SET IOUOFF=$GET(IOUOFF)
+7 DO ADMIT
DO POV
DO OP
DO PROV
DO OTHER
QUIT
+8 ;
ADMIT ; build display of admit data
+1 NEW LINE,VH
+2 SET VH=$ORDER(^AUPNVINP("AD",BDGV,0))
IF 'VH
Begin DoDot:1
+3 DO SET("** ERROR! Cannot find V Hospitalization Entry! **",.VALMCNT)
End DoDot:1
QUIT
+4 ;
+5 DO SET(IORVON_"General Admission Data"_IORVOFF,.VALMCNT)
+6 SET LINE=$$PAD(IOUON_"Admission",42)_"Discharge"_IOUOFF
+7 DO SET(LINE,.VALMCNT)
+8 ;
+9 SET LINE=$$PAD($$GET1^DIQ(9000010,BDGV,.01),38)
+10 SET LINE=LINE_$$GET1^DIQ(9000010.02,VH,.01)
+11 ;admit and disch dates
DO SET(LINE,.VALMCNT)
+12 ;
+13 SET LINE=$$PAD($$GET1^DIQ(9000010.02,VH,.04),38)
+14 SET LINE=LINE_$$GET1^DIQ(9000010.02,VH,.05)
+15 ;admit and disch services
DO SET(LINE,.VALMCNT)
+16 ;
+17 SET LINE=$$GET1^DIQ(9000010.02,VH,.07)_" ("
+18 SET X=$$GET1^DIQ(9000010.02,VH,.07,"I")
+19 SET LINE=$$PAD(LINE_$$GET1^DIQ(405.1,X,9999999.1)_")",38)
+20 SET LINE=LINE_$$GET1^DIQ(9000010.02,VH,.06)_" ("
+21 SET X=$$GET1^DIQ(9000010.02,VH,.06,"I")
+22 SET LINE=LINE_$$GET1^DIQ(405.1,X,9999999.1)_")"
+23 ;admit and disch types (IHS)
DO SET(LINE,.VALMCNT)
+24 ;
+25 SET LINE=$$GET1^DIQ(9000010.02,VH,6101)
+26 IF LINE]""
SET LINE=LINE_" ("_$$GET1^DIQ(9000010.02,VH,6101,"I")_")"
+27 SET LINE=$$PAD(LINE,38)_$$GET1^DIQ(9000010.02,VH,.09)
+28 ;admit type (ub92) & transfer facility
DO SET(LINE,.VALMCNT)
+29 ;
+30 SET LINE=$$GET1^DIQ(9000010.02,VH,6102)
+31 IF LINE]""
SET LINE=LINE_" ("_$$GET1^DIQ(9000010.02,VH,6102,"I")_")"
+32 SET LINE=$$PAD(LINE,38)_$$GET1^DIQ(9000010.02,VH,6103)
+33 SET LINE=LINE_" ("_$$GET1^DIQ(9000010.02,VH,6103,"I")_")"
+34 ;admit source & disch status (UB92 style)
DO SET(LINE,.VALMCNT)
+35 ;
+36 SET LINE="DX upon Admission: "
SET X=$ORDER(^DGPM("AVISIT",BDGV,0))
+37 IF X
SET LINE=LINE_$$GET1^DIQ(405,X,.1)
+38 ;free text admitting dx
DO SET(LINE,.VALMCNT)
+39 ;
+40 SET LINE=$$SP(5)_"Coded Adm DX: "_$$GET1^DIQ(9000010.02,VH,.12)
+41 IF $LENGTH(LINE)>10
SET LINE=LINE_" - "
+42 ;S LINE=LINE_$$GET1^DIQ(80,+$$GET1^DIQ(9000010.02,VH,.12,"I"),3)
+43 SET LINE=LINE_$PIECE($$ICDDX^ICDCODE(+$$GET1^DIQ(9000010.02,VH,.12,"I")),U,4)
+44 ;admitting dx
DO SET(LINE,.VALMCNT)
+45 ;
+46 SET LINE=$$SP(14)_"DRG: "_$$GET1^DIQ(9000010,BDGV,.34)
+47 IF $LENGTH(LINE)>9
SET LINE=LINE_" - "
+48 SET LINE=LINE_$GET(^ICD(+$$GET1^DIQ(9000010,BDGV,.34,"I"),1,1,0))
+49 ;visit DRG
DO SET(LINE,.VALMCNT)
+50 ;
+51 SET LINE=$$SP(7)_"# Consults: "_$$GET1^DIQ(9000010.02,VH,.08)
+52 DO SET(LINE,.VALMCNT)
+53 ;blank line between sections
DO SET("",.VALMCNT)
+54 QUIT
+55 ;
POV ; build diagnosis display
+1 NEW IEN,LINE,X,Y
+2 IF '$DATA(^AUPNVPOV("AD",BDGV))
Begin DoDot:1
+3 DO SET("** No Diagnoses Entered for Visit! **",.VALMCNT)
End DoDot:1
QUIT
+4 ;
+5 DO SET("",.VALMCNT)
DO SET(IORVON_"POV (Diagnoses)"_IORVOFF,.VALMCNT)
+6 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVPOV("AD",BDGV,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+7 SET LINE=$$GET1^DIQ(9000010.07,IEN,.01)
+8 SET LINE=$$PAD(LINE,8)_"("_$$GET1^DIQ(9000010.07,IEN,.12,"I")_") "
+9 SET LINE=LINE_$$GET1^DIQ(9000010.07,IEN,.019)
+10 ;icd code, prim/sec and icd description
DO SET(LINE,.VALMCNT)
+11 ;
+12 ;prov narr
DO SET($$SP(12)_$$GET1^DIQ(9000010.07,IEN,.04),.VALMCNT)
+13 ;
+14 SET X=$$GET1^DIQ(9000010.07,IEN,.06)
SET Y=$$GET1^DIQ(9000010.07,IEN,.07)
+15 IF (X]"")!(Y]"")
Begin DoDot:2
+16 DO SET($$PAD($$SP(12)_"Modifier: "_X,38)_"Cause of DX: "_Y,.VALMCNT)
End DoDot:2
+17 ;
+18 SET X=$$GET1^DIQ(9000010.07,IEN,.09)
IF X]""
Begin DoDot:2
+19 SET LINE=$$PAD($$SP(12)_"E-Code: "_X,38)_$$GET1^DIQ(9000010.07,IEN,.13)
+20 ;e-code & date of injury
DO SET(LINE,.VALMCNT)
+21 DO SET($$SP(12)_"Place of Accident: "_$$GET1^DIQ(9000010.07,IEN,.11),.VALMCNT)
+22 ;
+23 ;blank line between dx
DO SET("",.VALMCNT)
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
OP ; build list of procedures
+1 NEW IEN,LINE,X,Y
+2 ;no procedures
IF '$DATA(^AUPNVPRC("AD",BDGV))
QUIT
+3 ;
+4 DO SET("",.VALMCNT)
DO SET(IORVON_"Procedures"_IORVOFF,.VALMCNT)
+5 ;
+6 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVPRC("AD",BDGV,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+7 SET LINE=$$PAD($$GET1^DIQ(9000010.08,IEN,.01),10)
+8 ;princ procedure?
SET X=$$GET1^DIQ(9000010.08,IEN,.07)
+9 SET LINE=$$PAD(LINE_$SELECT(X="YES":" (P)",1:""),17)
+10 SET LINE=LINE_$$GET1^DIQ(9000010.08,IEN,.019)
+11 ;icd code, princ?, icd description
DO SET(LINE,.VALMCNT)
+12 ;
+13 ;prov narr
DO SET($$SP(10)_$$GET1^DIQ(9000010.08,IEN,.04),.VALMCNT)
+14 ;
+15 SET LINE=$$GET1^DIQ(9000010.08,IEN,.16)_$$GET1^DIQ(9000010.08,IEN,.17)
+16 SET LINE=LINE_$$SP(3)_$$GET1^DIQ(9000010.08,IEN,.1609)
+17 SET LINE=$$PAD("CPT: "_LINE,50)_"Infection? "
+18 SET LINE=LINE_$$GET1^DIQ(9000010.08,IEN,.08)
+19 ;CPT codes & infection question
DO SET(LINE,.VALMCNT)
+20 ;
+21 SET LINE="Date: "_$$GET1^DIQ(9000010.08,IEN,.06)
+22 SET X=$$GET1^DIQ(9000010.08,IEN,.05)
+23 IF X]""
Begin DoDot:2
+24 SET Y=$$GET1^DIQ(9000010.08,IEN,.05,"I")
+25 ;S X=X_$$SP(3)_$$GET1^DIQ(80,Y,3)
+26 SET X=X_$$SP(3)_$PIECE($$ICDDX^ICDCODE(Y),U,4)
End DoDot:2
+27 ;date & dx
DO SET($$PAD(LINE,30)_"Dx: "_X,.VALMCNT)
+28 ;
+29 SET LINE="Operating: "_$$GET1^DIQ(9000010.08,IEN,.11)
+30 SET X=$$GET1^DIQ(9000010.08,IEN,.12)
+31 IF X]""
SET LINE=$$PAD(LINE,38)_"Anesthesiologist: "_X
+32 ;providers-operating & anesthesia
DO SET(LINE,.VALMCNT)
+33 ;
+34 SET X=$$GET1^DIQ(9000010.08,IEN,.14)
+35 IF X="YES"
Begin DoDot:2
+36 SET LINE="Elapsed Time (Anes): "_$$GET1^DIQ(9000010.08,IEN,.13)
+37 SET LINE=$$PAD(LINE,38)_"ASA-PS Class: "_$$GET1^DIQ(9000010.08,IEN,.15)
+38 ;anesthesia data
DO SET(LINE,.VALMCNT)
End DoDot:2
+39 ;
+40 ;blank line between procedures
DO SET("",.VALMCNT)
End DoDot:1
+41 QUIT
+42 ;
PROV ; build display of providers
+1 NEW IEN,LINE,X,Y
+2 IF '$DATA(^AUPNVPRV("AD",BDGV))
Begin DoDot:1
+3 DO SET("** No Providers Entered for Visit! **",.VALMCNT)
End DoDot:1
QUIT
+4 ;
+5 DO SET("",.VALMCNT)
DO SET(IORVON_"Providers"_IORVOFF,.VALMCNT)
+6 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVPRV("AD",BDGV,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+7 ;prov name
SET LINE=$$PAD($$GET1^DIQ(9000010.06,IEN,.01),37)
+8 ;prov code
SET LINE=LINE_$$GET1^DIQ(9000010.06,IEN,.019)
+9 ;prim/sec
SET X=$$GET1^DIQ(9000010.06,IEN,.04)
+10 ;atten/oper/cons
SET Y=$$GET1^DIQ(9000010.06,IEN,.05)
+11 SET LINE=$$PAD(LINE,50)_X_$SELECT(Y]"":"/"_Y,1:"")
+12 DO SET(LINE,.VALMCNT)
DO SET("",.VALMCNT)
End DoDot:1
+13 QUIT
+14 ;
OTHER ; build display of all other PCC data for patient's visit
+1 NEW FILE,GLOBAL,IEN,LINE,X,Y,NAME
+2 SET FILE=9000010
+3 FOR
SET FILE=$ORDER(^DIC(FILE))
IF 'FILE
QUIT
IF (FILE>9000010.9999)
QUIT
Begin DoDot:1
+4 IF FILE=9000010.02
QUIT
IF FILE=9000010.06
QUIT
IF FILE=9000010.07
QUIT
+5 IF FILE=9000010.08
QUIT
+6 SET GLOBAL=$GET(^DIC(FILE,0,"GL"))
IF GLOBAL=""
QUIT
+7 ;strip off parens for indirection
SET GLOBAL=$PIECE(GLOBAL,"(")
+8 SET NAME=$PIECE($PIECE(^DIC(FILE,0),U),"V ",2)
+9 ;
+10 IF $DATA(@GLOBAL@("AD",BDGV))
DO SET("",.VALMCNT)
DO SET(IORVON_NAME_IORVOFF,.VALMCNT)
+11 ;
+12 SET IEN=0
FOR
SET IEN=$ORDER(@GLOBAL@("AD",BDGV,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+13 SET LINE=$$GET1^DIQ(FILE,IEN,.01)
+14 ;
+15 ; do CPT file differently
+16 IF NAME="CPT"
Begin DoDot:3
+17 SET LINE=LINE_$$GET1^DIQ(FILE,IEN,.08)_$$SP(4)
+18 ;quantity
SET X=$$GET1^DIQ(FILE,IEN,.16)
+19 SET LINE=LINE_"("_$SELECT(X="":1,1:X)_") "
+20 ;cpt short name
SET LINE=LINE_$$GET1^DIQ(FILE,IEN,.019)
+21 DO SET(LINE,.VALMCNT)
DO SET("",.VALMCNT)
End DoDot:3
QUIT
+22 ;
+23 SET LINE=LINE_$$SP(3)_$$GET1^DIQ(FILE,IEN,.04)
+24 DO SET(LINE,.VALMCNT)
DO SET("",.VALMCNT)
End DoDot:2
End DoDot:1
+25 QUIT
+26 ;
SET(DATA,NUM) ; puts display data into array
+1 SET NUM=NUM+1
+2 SET ^TMP("BDGPCCE",$JOB,NUM,0)=DATA
+3 QUIT
+4 ;
PAD(D,L) ;EP -- SUBRTN to pad length of data
+1 ; -- D=data L=length
+2 QUIT $EXTRACT(D_$$REPEAT^XLFSTR(" ",L),1,L)
+3 ;
SP(N) ; -- SUBRTN to pad N number of spaces
+1 QUIT $$PAD(" ",N)
